Can these VBA code be Altered

[Toonies]

Hi and thank you for looking at my post

I have the found the following VBA code and amended it, which works on 2 sheets, but it only collects the data 1 sheet at a time using 2 separate forms

What I am trying to do is for the VBA to collect the data from both sheets at the same time ie: using only 1 form.

Private Sub ComboBox1_Change()
    Dim lngRow As Long
    Dim rngData As Range
    If Me.ComboBox1.ListIndex <> -1 Then
        ' get row number - employee range starts in row 6
        lngRow = 6 + Me.ComboBox1.ListIndex
        With Sheet1
            Set rngData = .Range(.Cells(lngRow, "C"), .Cells(lngRow, "GD"))
        End With
        Me.TextBox1.Value = CountByColor(rngData, Sheet1.Range("B47")) ' holiday
        Me.TextBox2.Value = CountByColor(rngData, Sheet1.Range("B48")) ' sick leave
        Me.TextBox3.Value = CountByColor(rngData, Sheet1.Range("B49")) ' other
    End If
End Sub
Function CountByColor(InputRange As Range, ColorRange As Range) As Long
Dim cl As Range, TempCount As Long, ColorIndex As Integer
    ColorIndex = ColorRange.Cells(1, 1).Interior.ColorIndex
    TempCount = 0
    For Each cl In InputRange.Cells
        If cl.Interior.ColorIndex = ColorIndex Then
            TempCount = TempCount + 1
        End If
    Next cl
    Set cl = Nothing
    CountByColor = TempCount
End Function
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub Label1_Click()
End Sub
Private Sub Label3_Click()
End Sub
Private Sub UserForm_Initialize()
ComboBox1.List = Worksheets("January-June").Range("B6:B45").Value

End Sub
Private Sub UserForm_Initialise()
ComboBox1.List = Worksheets("July-December").Range("B6:B45").Value

End Sub

Hopefully i have explained it correctly

the original code can be found at

http://www.mrexcel.com/forum/showthread.php?t=539877&highlight=planner

I have also asked a similar question at
http://www.vbaexpress.com/forum/showthread.php?t=38930

 

[AlphaFrog]

Do the two ranges "B6:B45" on both sheets have exactly the same list in the same order?

You want to add the CountByColor results from both sheets and put the totals in the Textboxes?

If yes to both...

Private Sub UserForm_Initialize()
    ComboBox1.List = Worksheets("January-June").Range("B6:B45").Value
End Sub

Private Sub ComboBox1_Change()
    Dim lngRow As Long
    Dim rngData As Range
    If Me.ComboBox1.ListIndex <> -1 Then
        ' get row number - employee range starts in row 6
        lngRow = 6 + Me.ComboBox1.ListIndex
        With Worksheets("January-June")
            Set rngData = .Range(.Cells(lngRow, "C"), .Cells(lngRow, "GD"))
            Me.TextBox1.Value = CountByColor(rngData, .Range("B47")) ' holiday
            Me.TextBox2.Value = CountByColor(rngData, .Range("B48")) ' sick leave
            Me.TextBox3.Value = CountByColor(rngData, .Range("B49")) ' other
        End With
        With Worksheets("July-December")
            Set rngData = .Range(.Cells(lngRow, "C"), .Cells(lngRow, "GD"))
            Me.TextBox1.Value = Me.TextBox1.Value + CountByColor(rngData, .Range("B47")) ' holiday
            Me.TextBox2.Value = Me.TextBox2.Value + CountByColor(rngData, .Range("B48")) ' sick leave
            Me.TextBox3.Value = Me.TextBox3.Value + CountByColor(rngData, .Range("B49")) ' other
        End With
    End If
End Sub

Function CountByColor(InputRange As Range, ColorRange As Range) As Long
Dim cl As Range, TempCount As Long, ColorIndex As Integer
    ColorIndex = ColorRange.Cells(1, 1).Interior.ColorIndex
    TempCount = 0
    For Each cl In InputRange.Cells
        If cl.Interior.ColorIndex = ColorIndex Then
            TempCount = TempCount + 1
        End If
    Next cl
    Set cl = Nothing
    CountByColor = TempCount
End Function

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub Label1_Click()
End Sub

Private Sub Label3_Click()
End Sub

 

[Toonies]

AlphaFrog thats "Perfect"

It works like a Dream

Many thanks

Toonies