Copying values from one workbook to another with isdate condition-CodePudding

I am trying to copy from one workbook to another the total number of hours worked for each date, avoiding dates with 0 hours. I'm having problems selecting the source for it, with the conditions. This is what I managed to do so far but it is not working, and I've been banging my head on it for 2 days now. Any ideas are gladly appreciated.

Public Sub hour_count_update()

Dim wb_source As Worksheet, wb_dest As Worksheet
Dim source_month As Range
Dim source_date As Range
Dim dest_month As Range

Set wb_source = Workbooks("2022_Onyva_Ore Personale Billing.xlsx").Worksheets("AMETI")
Set wb_dest = Workbooks("MACRO ORE BILLING 2022.xlsm").Worksheets("RiepilogoOre")
Set dest_month = wb_dest.Cells(wb_dest.Rows.Count, "B") _
        .End(xlUp)

wb_dest.Range("A2:C600").Clear 'cancella dati del foglio RiepilogoOre

For Each source_month In wb_source.Range("A1:A600")
    If source_month.Interior.Color = RGB(255, 255, 0) Then
        For Each source_date In source_month.Offset(1, 0).EntireRow
            If IsDate(source_date) Then
                MsgBox "It is a date"
                Set dest_month = dest_month.Offset(1)
                    dest_month.Value = source_date.Value
            End If
        Next source_date
    End If
Next source_month
        

End Sub

Here are screenshots of the worksheets: Source Workbook: Destination Workbook: Expected output:

CodePudding user response：

ok so first thing, getting your code to work which seems to just msgbox and pull out any date:

I'm not sure why but when I run this, VBA doesn't enjoy this line:

    For Each source_date In source_month.Offset(1, 0).EntireRow

by replacing that line with:

        For Each source_date In source_month.Offset(1, 0).Resize(, 100)

the code seems to run fine (here i do 100 columns but you can easily change this to more)

Next at the moment you are populating all dates and you only want ones with a value and you want that value so for that I think you'll need something like:

                For Each rng In source_date.Resize(100, 0)
                    If rng.Interior.Color = RGB(255, 255, 255) Then
                        hoursWorked = rng.Value
                    End If
                Next rng

where rng is a range and the RGB is the background colour of the total hours

putting it together you get:

Public Sub hour_count_update()

Dim wb_source As Worksheet, wb_dest As Worksheet
Dim source_month As Range
Dim source_date As Range
Dim dest_month As Range
Dim rng As Range


Set wb_source = ActiveWorkbook.Worksheets("Sheet19")
Set wb_dest = ActiveWorkbook.Worksheets("Sheet20")
Set dest_month = wb_dest.Cells(wb_dest.Rows.Count, "B").End(xlUp)

wb_dest.Range("A2:C600").Clear 'cancella dati del foglio RiepilogoOre

For Each source_month In wb_source.Range("A1:A600")
    source_month.Select
    If source_month.Interior.Color = RGB(255, 255, 0) Then
        For Each source_date In source_month.Offset(1, 0).Resize(, 100)
            If IsDate(source_date.Value) Then
            
                For Each rng In source_date.Resize(100, 0)
                    If rng.Interior.Color = RGB(255, 255, 255) Then
                        hoursWorked = rng.Value
                    End If
                Next rng
            
            
                MsgBox "It is a date"
                Set dest_month = dest_month.Offset(1)
                    dest_month.Value = source_date.Value
            End If
        Next source_date
    End If
Next source_month

End Sub

I haven't tested the hours worked bit and you can see I haven't done anything with them

Please let me know how you get on or if I can help more!

CodePudding user response：

I have managed to resolve this part of the project. As user1236777 pointed out the .EntireRow was behaving and I still have to figure out why. The .Resize worked wonders.

I then made ArrayLists to filter out Dates with hours equal to 0. This what came up. Thanks for help!

Public Sub hour_count_update2()

'Dichiarazioni
Dim wb_source As Worksheet, wb_dest As Worksheet
Dim source_month As Range
Dim source_date As Range
Dim dest_month As Range
Dim source_total_hours As Range
Dim source_hours
Dim dest_hours As Range
Dim dest_name As Range
Dim date_list As ArrayList
    Set date_list = New ArrayList
Dim hours_list As ArrayList
    Set hours_list = New ArrayList

Set wb_source = Workbooks("2022_Onyva_Ore Personale Billing.xlsx").Worksheets("AMETI")
Set wb_dest = Workbooks("MACRO ORE BILLING 2022.xlsm").Worksheets("RiepilogoOre")

wb_dest.Range("A2:C600").Clear

Set dest_name = wb_dest.Cells(wb_dest.Rows.Count, "A") _
        .End(xlUp)
Set dest_month = wb_dest.Cells(wb_dest.Rows.Count, "B") _
        .End(xlUp)
Set dest_hours = wb_dest.Cells(wb_dest.Rows.Count, "C") _
        .End(xlUp)

For Each source_total_hours In wb_source.Range("B130")
    If source_total_hours = "TOTALE ORE" Then
        For Each source_hours In source_total_hours.Offset(0, 3).Resize(, 50)
            If IsNumeric(source_hours) Then
                hours_list.Add (source_hours)
            End If
        Next source_hours
    End If
Next source_total_hours

For Each source_month In wb_source.Range("A1:A600")
    If source_month.Value = "01/05/2022" Then
        For Each source_date In source_month.Offset(1, 0).Resize(, 50)
            If IsDate(source_date) Then
                date_list.Add (source_date)
            End If
        Next source_date
    End If
Next source_month

For Each i In hours_list
    If i <> 0 Then
        Set dest_month = dest_month.Offset(1)
            dest_month.Value = date_list(0)
            date_list.RemoveAt 0
        Set dest_hours = dest_hours.Offset(1)
            dest_hours.Value = i
        Set dest_name = dest_name.Offset(1)
            dest_name.Value = wb_source.Range("B1")
    Else: On Error Resume Next
        date_list.RemoveAt 0
    End If
Next i

End Sub