Reputation: 1739
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
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