Geek Answers Handbook

VBA Macro - Defining a New Worksheet for Data

Right now I have a piece of code that can take start and end dates and list all dates in this date range. This allows me to take the following table and split it into separate dates.

| Name | StartDate | Endate
| Bob The builder | 05/20/2015 | 05/24/2015
| Tiny Tim | 06/08/2015 | 06/09/2015
| Dolly Parton | 08/06/2015 | 08/08/2015

However, at the moment, it uploads the created data directly below the existing table as follows:

| Name | StartDate | Endate
| Bob The builder | 05/20/2015 | 05/24/2015
| Tiny Tim | 06/08/2015 | 06/09/2015
| Dolly Parton | 08/06/2015 | 08/08/2015
| Bob The builder | 05/20/2015 |
| Bob The builder | 05/21/2015 |
| Bob The builder | 05/22/2015 |
| Bob The builder | 05/23/2015 |
| Bob The builder | 05/24/2015 |
| Tiny Tim | 06/08/2015 |
| Tiny Tim | 06/09/2015 |
| Dolly Parton | 08/06/2015 |
| Dolly Parton | 08/07/2015 |
| Dolly Parton | 08/08/2015 |

I tried several ways to try to find it on a new sheet, and every time I fool myself with the code that it fails. Also note that copying the generated data will not work, since every time I run this macro, the original table will have a different number of rows. This is the code I used:

Sub SeparateDateRange()

Dim Ws As Worksheet
Dim nCol As Integer


Set Ws = ActiveSheet

nCol = 1 

Application.ScreenUpdating = False


For i = 1 To ActiveSheet.Cells(Rows.Count, nCol + 2).End(xlUp).Row - 1 Step 1 

    For j = 0 To Ws.Cells(i + 1, nCol + 2).Value - Ws.Cells(i + 1, nCol + 1).Value Step 1 

  With Ws.Cells(Ws.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
    For k = 0 To nCol - 1 Step 1
        .Offset(0, k).Value = Ws.Cells(i + 1, k + 1).Value
    Next k

    .Offset(0, nCol).Value = DateSerial(Year(Ws.Cells(i + 1, nCol + 1).Value), Month(Ws.Cells(i + 1, nCol + 1).Value), Day(Ws.Cells(i + 1, nCol + 1).Value) + j)
    End With

    Next j
Next i

Application.ScreenUpdating = True

End Sub
+4
source share
1 answer

The problem you are experiencing is that you are creating the generated offset values Wsthat you defined as the active sheetSet Ws = ActiveSheet

This is reflected here:

With Ws.Cells(Ws.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
For k = 0 To nCol - 1 Step 1
    .Offset(0, k).Value = Ws.Cells(i + 1, k + 1).Value
Next k

    .Offset(0, nCol).Value = DateSerial(Year(Ws.Cells(i + 1, nCol + 1).Value), Month(Ws.Cells(i + 1, nCol + 1).Value), Day(Ws.Cells(i + 1, nCol + 1).Value) + j)
End With

Instead of using an active sheet, define a new sheet to insert values ​​and reference it in With, for example:

Dim newWS as worksheet
Set newWS = Sheets("SheetName")

With newWS.Cells(newWS.Cells(newWS.Rows.Count, 1).End(xlUp).Row + 1, 1)

.

+2

More articles:


All Articles