VBA inserting data where it should not

Question

So Im trying to create a VBA that copies data from 4 sheets that have the same structure into another sheet and in that sheet I have extra two columns YearMonth and SourceSheet. The sourcesheet column should contain info from which of the 4 sheets the data is from and yearmonth is populated based on the selected month from cell F1 of calculation sheet. Problem is that the yearmonth and sourcesheet columns continue putting data all the way down where they shouldn't be. So for example row 298 is the last one and all other columns are fine except the sourcesheet and yearmonth which continue to row 400 something for some reason.

Im mainly using chatgpt for help as Im beginner with VBA and it still gives me a code that has the same issue. Can you help me what is wrong?

The code is:

Sub CopyDataToDataSheet()
    Dim dataSheet As Worksheet
    Dim inputSheet As Worksheet
    Dim calculationSheet As Worksheet
    Dim lastRow As Long
    Dim yearMonthValue As Variant
    Dim confirmation As Integer
    Dim yearMonthColumn As Range
    Dim sourceSheetColumn As Range
    Dim dataRange As Range
    Dim sourceSheetNames As Variant
    Dim dataLastRow As Long`
    
 
    
    ' Set the data sheet
    Set dataSheet = ThisWorkbook.Worksheets("Data Archive")
    
    ' Unfilter the data sheet
    If dataSheet.AutoFilterMode Then
        dataSheet.AutoFilterMode = False
    End If
    
    ' Set the calculation sheet
    Set calculationSheet = ThisWorkbook.Worksheets("Calculation")
    
    ' Find the column index of "SourceSheet" in the data sheet
    Set sourceSheetColumn = dataSheet.Rows(1).Find("SourceSheet", LookIn:=xlValues, LookAt:=xlWhole)
    
    ' Loop through the input sheets
    sourceSheetNames = Array("sheet1", "sheet2", "sheet3", "sheet4")
    For Each inputSheet In ThisWorkbook.Worksheets(sourceSheetNames)
        ' Find the last row in the data sheet
        lastRow = dataSheet.Cells(dataSheet.Rows.Count, "A").End(xlUp).Row
        
        ' Copy the data from the input sheet to the data sheet
        Set dataRange = inputSheet.UsedRange.Offset(1)
        dataRange.Copy dataSheet.Cells(lastRow + 1, "A")
        
        ' Get the value from cell F1 of the Calculation sheet
        yearMonthValue = calculationSheet.Range("F1").Value
        
        ' Check if "SourceSheet" column exists
        If Not sourceSheetColumn Is Nothing Then
            ' Find the last row of imported data in column A
            dataLastRow = lastRow + dataRange.Rows.Count
            
            ' Assign the source sheet name to the "SourceSheet" column in the data sheet for each row
            dataSheet.Range(dataSheet.Cells(lastRow + 1, sourceSheetColumn.Column), dataSheet.Cells(dataLastRow, sourceSheetColumn.Column)).Value = inputSheet.Name
            
            ' Clear the remaining cells in the "SourceSheet" column below the imported data
            dataSheet.Range(dataSheet.Cells(dataLastRow + 1, sourceSheetColumn.Column), dataSheet.Cells(dataSheet.Rows.Count, sourceSheetColumn.Column)).ClearContents
        End If
        
        ' Find the column index of "YearMonth" in the data sheet
        Set yearMonthColumn = dataSheet.Rows(1).Find("YearMonth", LookIn:=xlValues, LookAt:=xlWhole)
        
        ' Check if "YearMonth" column exists
        If Not yearMonthColumn Is Nothing Then
            ' Assign the yearMonthValue to the "YearMonth" column in the data sheet for each row
            dataSheet.Range(dataSheet.Cells(lastRow + 1, yearMonthColumn.Column), dataSheet.Cells(dataLastRow, yearMonthColumn.Column)).Value = yearMonthValue
            
            ' Clear the remaining cells in the "YearMonth" column below the imported data
            dataSheet.Range(dataSheet.Cells(dataLastRow + 1, yearMonthColumn.Column), dataSheet.Cells(dataSheet.Rows.Count, yearMonthColumn.Column)).ClearContents
        End If
        
        ' Delete the data from the input sheet
        ' dataRange.ClearContents
    Next inputSheet
    
    ' Display success message
    MsgBox "Data imported successfully."
End Sub`

Answer 1

Its not clear why you got results off by hundreds of rows. There could be something weird in your data. Sometimes in Excel there is invisible data or even formatting that gets picked up when you use a "UsedRange" in VBA. So you could try bringing in a "ReallyUsedRange" function to use instead of inputSheet.UsedRange. See for example here: getting-the-actual-usedrange

I've put a new version of the code below.

Some thoughts on ChatGPT's code:

• The validation should go earlier in the code, not inside the loop. So if the column indexes can't be resolved, no need to even start the loop.
• You want to always let the user know when things didn't work correctly (i.e., if validation fails).
• Also it seems a little arbitrary with the validation - columns are validated, but not whether other sheets exists, or a correct year-date value is found, or whether input data has the right shape (# of columns). Maybe all that has to do with your "instructions" for ChatGPT though.
• The row counting of the data copied just didn't work.
• It is not handling empty input sheets correctly either.
• I don't see any reason to clear data below the data you copied in to the DataArchive, because by definition that went to the last row and their is no data below it.
• As noted above UsedRange is a bit unreliable if you aren't careful and understand how you are using it.
• Our jobs appear to be safe still, at least for now :) Impressive nonetheless, so continuing to watch where ChatGPT goes.

New Code:

Sub CopyDataTowsTarget()

Dim wsTarget As Worksheet
Dim wsSource As Worksheet
Dim yearMonth As Variant
Dim i As Long
Dim j As Long
Dim r As Range
Dim s_col As Long
Dim y_col As Long
Dim arr
    
'Prequisites

' Sheet named DataArchive with columns A, B, C, D, SourceSheet, YearMonth and some random data in cells A2:D10
' Sheet named Calculation with '2023-05' in cell F1
' four sheets sheet1, sheet2, sheet3, sheet4 with random data in cells A2:D10 (may be a few more or less rows)
    
    ' Set the data sheet
    Set wsTarget = ThisWorkbook.Worksheets("Data Archive")
    
    'only to make things go faster while debugging
    'wsTarget.Range("A11:J1000").Clear 
    
    If wsTarget.AutoFilterMode Then
        wsTarget.AutoFilterMode = False
    End If
    
    yearMonth = Worksheets("Calculation").Range("F1").Value
    
    ' Get the MonthYear and SourceSheet column indexes
    Set r = wsTarget.Rows(1).Find("SourceSheet", LookIn:=xlValues, LookAt:=xlWhole)
    If r Is Nothing Then
        MsgBox "Source Sheet Column not Found!"
        Exit Sub
    Else
        s_col = r.Column
    End If
    
    Set r = wsTarget.Rows(1).Find("YearMonth", LookIn:=xlValues, LookAt:=xlWhole)
    If r Is Nothing Then
        MsgBox "Source Sheet Column not Found!"
        Exit Sub
    Else
        y_col = r.Column
    End If
        
    ' Copy data from input sheets to Archive sheet
    arr = Array("sheet1", "sheet2", "sheet3", "sheet4")
    For Each wsSource In Worksheets(arr)
        
        i = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1
        Set r = wsSource.UsedRange.Offset(1)
        If r.Rows.Count > 1 Then
            Set r = wsSource.UsedRange.Offset(1)
            Set r = r.Resize(r.Rows.Count - 1)
            r.Copy
            wsTarget.Cells(i, "A").PasteSpecial xlPasteValuesAndNumberFormats
            wsTarget.Cells(i, s_col).Resize(r.Rows.Count).Value = wsSource.Name
            wsTarget.Cells(i, y_col).Resize(r.Rows.Count).Value = yearMonth
            ' dataRange.ClearContents
        End If
    Next wsSource
    
    ' Display success message
    MsgBox "Data imported successfully."

End Sub

If your input sheets do not have headers, the code needs a little tweaking for that. Also if you don't want the paste to be values adjust as well (I routinely use PasteSpecial with xlPasteValuesAndNumberFormats because usually for archiving you want the raw data without worry about bad formula references.