aab
aab

Reputation: 1739

Excel VBA copy data into a different sheet

I want to find the highest value in the second row of the '2G' sheet and paste it's entire column into the 'Daily2G' sheet. The first row of the '2G' sheet has the date and time (24 hour period).

The code also compares the date and only copies the data if the dates are different.

The code was working fine for the past two days, but it isn't working today. I can't figure out what the problem is. I would appreciate it if someone could take a look at the code and tell me where I'm going wrong.

The code works if I compare the values in any other row but I want to check the values only in the second row. Also the duplicate check is also not working, it was before today.

Sub Daily2G()
    Dim dailySht As Worksheet 'worksheet storing latest store activity
    Dim recordSht As Worksheet 'worksheet to store the highest period of each day
    Dim lColDaily As Integer ' Last column of data in the store activity sheet
    Dim lCol As Integer ' Last column of data in the record sheet
    Dim maxCustomerRng As Range ' Cell containing the highest number of customers
    Dim CheckForDups As Range ' Used to find duplicate dates on the record Sheet
    Dim maxCustomerCnt As Long ' value of highest customer count

    Set dailySht = ThisWorkbook.Sheets("2G")
    Set recordSht = ThisWorkbook.Sheets("Daily 2G")
    With recordSht
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With
    With dailySht
        lColDaily = .Cells(1, .Columns.Count).End(xlToLeft).Column
        maxCustomerCnt = Application.Max(.Range(.Cells(2, 1), .Cells(2, lColDaily)))
        Set maxCustomerRng = .Range(.Cells(2, 1), .Cells(2, lColDaily)).Find(What:=maxCustomerCnt, LookIn:=xlValues)
        If Not maxCustomerRng Is Nothing Then
        ' Check the Record Sheet to ensure the data is not already there
            Set CheckForDups = recordSht.Range(recordSht.Cells(1, 1), recordSht.Cells(1, lCol)).Find(What:=maxCustomerRng.Offset(-1, 0).Value, LookIn:=xlValues)
        ' If CheckForDups is Nothing then the date was not found on the record sheet. Therefore, copy the column
            If CheckForDups Is Nothing Then
                maxCustomerRng.EntireColumn.Copy
                recordSht.Cells(1, lCol + 1).PasteSpecial xlPasteValues
                recordSht.Cells(1, lCol + 1).PasteSpecial xlPasteFormats
            End If
        End If
    End With

    Set maxCustomerRng = Nothing
    Set dailySht = Nothing
    Set recordSht = Nothing
End Sub

Upvotes: 2

Views: 103

Answers (1)

Subodh Tiwari sktneer
Subodh Tiwari sktneer

Reputation: 9976

Not sure how and what are you trying to find as duplicate so changed a bit in the code so that if, as per the sample file, 3488.95 isn't found in row2 in Daily2G Sheet, the code will copy the column with Max value to the Daily2G sheet else it will skip.

Also, in the sample file, the Sheet name is "Daily2G" not "Daily 2G", so changed it in the code and you change it in your actual workbook as required.

The problem with your code is you have declared maxCustomerCnt as long whereas the values in row2 on 2G sheet are decimal values so the NaxCustomerRng will always be nothing.

Please give this a try...

Sub Daily2G()
    Dim dailySht As Worksheet 'worksheet storing latest store activity
    Dim recordSht As Worksheet 'worksheet to store the highest period of each day
    Dim lColDaily As Integer ' Last column of data in the store activity sheet
    Dim lCol As Integer ' Last column of data in the record sheet
    Dim maxCustomerRng As Range ' Cell containing the highest number of customers
    Dim CheckForDups As Range ' Used to find duplicate dates on the record Sheet
    Dim maxCustomerCnt As Double ' value of highest customer count

    Set dailySht = ThisWorkbook.Sheets("2G")
    Set recordSht = ThisWorkbook.Sheets("Daily2G")
    With recordSht
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With
    With dailySht
        lColDaily = .Cells(1, .Columns.Count).End(xlToLeft).Column
        maxCustomerCnt = Round(Application.Max(.Range(.Cells(2, 1), .Cells(2, lColDaily))), 2)
        Set maxCustomerRng = .Range(.Cells(2, 1), .Cells(2, lColDaily)).Find(What:=maxCustomerCnt, LookIn:=xlValues)
        If Not maxCustomerRng Is Nothing Then
        ' Check the Record Sheet to ensure the data is not already there
            Set CheckForDups = recordSht.Range(recordSht.Cells(2, 1), recordSht.Cells(2, lCol)).Find(What:=Round(maxCustomerRng.Value, 2), LookIn:=xlValues)
        ' If CheckForDups is Nothing then the date was not found on the record sheet. Therefore, copy the column
            If CheckForDups Is Nothing Then
                maxCustomerRng.EntireColumn.Copy
                recordSht.Cells(1, lCol + 1).PasteSpecial xlPasteValues
                recordSht.Cells(1, lCol + 1).PasteSpecial xlPasteFormats
            End If
        End If
    End With

    Set maxCustomerRng = Nothing
    Set dailySht = Nothing
    Set recordSht = Nothing
End Sub

Run the above code in the sample file you provided and if it works well, test it with your actual file after making required changes.

Upvotes: 2

Related Questions