Help with copying data

[davide128]

Hi. I have a spreadsheet like so..

Basically, I need to iterate through the table in Columns F-K. (So in this case there are 4 records)Column K is the name of a worksheet so based on that value I need to switch to that sheet..search column D in that work sheet and if the value in Column H is found then I need to copy that whole row and place it into a new sheet that I will create called Final Output.. any help in how to do this using vba? Note..The Final output sheet will basically be data(rows) from multiple sheets that was copied based on the search criteria(Column H)

 

[davide128]

Anyone?

 

[davide128]

Think I got it..I would love to see how anyone else would do this..I up for learning and finding a better way to do things.. Here is the code...'

Dim strGlassType As String
Dim strProductLine As String
Dim strProductType As String
Dim strPaneOptions As String
Dim strAirSpace As String
Dim strGridType As String
Dim outputRowsCount As Long
Dim outputRowTracker As Long
'---------------------------------------------------
Private Sub btnExec_Click()
'---------------------------------------------------
Sheets("Final Output").Rows("2:" & Rows.Count).Delete Shift:=xlUp
outputRowsCount = 1 'start at Row 2 of Final Output
outputRowTracker = 2 'Where are we Final Output
Dim LR As Long, LC As Long, i As Long, rws As Long
Dim LookForVal As String
Dim LookForVal_2 As String
Dim numRecords As String
numRecords = ActiveSheet.ListObjects("tblConfigData").ListRows.Count
If numRecords > 0 Then
    For i = 2 To numRecords + 1
    
        ControlPanel.Activate
        strGlassType = ActiveSheet.range("K" & i).Value
        strPaneOptions = ActiveSheet.range("H" & i).Value
        strProductLine = ActiveSheet.range("F" & i).Value
        strProductType = ActiveSheet.range("G" & i).Value
        strAirSpace = ActiveSheet.range("I" & i).Value
        strGridType = ActiveSheet.range("J" & i).Value
        'outputRowsCount = 2 'start at Row 2 of Final Output
        
        MsgBox (strProductLine)
        If strGlassType <> "Monolithic" And strGlassType <> "Lami-PVB" _
                            And strGlassType <> "Lami-SGP" Then 'look at LookForVal and LookForVal_2
        
            Dim searchArray() As String
            searchArray = Split(strPaneOptions, ";")
            LookForVal = searchArray(0)
            
            LookForVal_2 = searchArray(1)
            copyRows strGlassType, LookForVal, LookForVal_2
            
            'Sheets(strGlassType).Activate
        Else ' Not dealing with IG
            LookForVal = strPaneOptions
            copyRows strGlassType, LookForVal
            'Sheets(strGlassType).Activate
        End If
    Next i
    
Else
    MsgBox ("You have not added any configurations")
    Exit Sub
End If
Sheets("Final Output").Select
End Sub
'---------------------------------------------------
Private Sub copyRows(sheetID As String, searchVal_1 As String, Optional searchVal_2 As String = "_BLANK")
'---------------------------------------------------
    Dim stOrig As Worksheet
    'Dim stName As Worksheet
    Dim idCont As Long
    
    Set stOrig = Sheets(sheetID)
    idCont = Application.CountA(stOrig.Columns(1))
    
    For i = 2 To idCont
        
        If stOrig.range("D" & i).Value = Evaluate(searchVal_1) Then
        
            If searchVal_2 <> "_BLANK" Then
                
                If stOrig.range("G" & i).Value = Evaluate(searchVal_2) Then
                    outputRowsCount = outputRowsCount + 1
                    stOrig.Rows(i).Copy Destination:=Sheets("Final Output").Rows(outputRowsCount)
                    
                    
                    
                End If
            Else 'we are not dealing with IG
                outputRowsCount = outputRowsCount + 1
                stOrig.Rows(i).Copy Destination:=Sheets("Final Output").Rows(outputRowsCount)
                
                
                
            End If
        End If
    Next i
    
    If outputRowsCount > 2 Then
       Sheets("Final Output").range("A" & outputRowTracker & ":A" & outputRowsCount).Value = strProductLine
       Sheets("Final Output").range("B" & outputRowTracker & ":B" & outputRowsCount).Value = strProductType
       Sheets("Final Output").range("K" & outputRowTracker & ":K" & outputRowsCount).Value = strAirSpace
       Sheets("Final Output").range("M" & outputRowTracker & ":M" & outputRowsCount).Value = strGridType
       outputRowTracker = outputRowsCount + 1
    End If
    
End Sub
'---------------------------------------------------
Private Sub cboGlassType_Change()
'---------------------------------------------------
    Dim iTargetCol As Long
    Dim oFoundCell As range
    
    Application.ScreenUpdating = False
    
    'By Default all checkboxes are checked - set toggle button accordingly
    tglSelectCHKBox.Value = False
    tglSelectCHKBox.Caption = "Deselect All"
    
    
    
    With ConfigData.range(kList1Hnd)
        ConfigData.Activate
        Set oFoundCell = .Find(what:=cboGlassType.Value, _
                               LookIn:=xlValues)
                               
        If oFoundCell Is Nothing Then
            MsgBox "Critical error", vbCritical, kApp
            Exit Sub
        End If
        ControlPanel.Activate
    End With
    
    'load the PaneOptions dropdown and set the default to item 1
    iTargetCol = oFoundCell.Column - 1
    fzPopulatList2 iTargetCol
    
    If cboGlassType.Value = "Monolithic" Or cboGlassType.Value = "Lami-PVB" _
                            Or cboGlassType.Value = "Lami-SGP" Then 'Disable N/A attributes for Monolithic
                
        lblAirSpace.Visible = False
        txtAirSpace.Visible = False
        
        lblGridType.Visible = True
        ckboGridType_N.Visible = True
        ckboGridType_G.Visible = True
        ckboGridType_GBG.Visible = False
        ckboGridType_Contour.Visible = False
        ckboGridType_S.Visible = False
        
        
        ckboGridType_N.Value = True
        ckboGridType_G.Value = True
        ckboGridType_GBG.Value = False
        ckboGridType_Contour.Value = False
        ckboGridType_S.Value = False
        
        txtAirSpace.Value = ""
        strAirSpace = ""
    Else
        lblAirSpace.Visible = True
        txtAirSpace.Visible = True
        lblGridType.Visible = True
        ckboGridType_N.Visible = True
        ckboGridType_G.Visible = True
        ckboGridType_GBG.Visible = True
        ckboGridType_Contour.Visible = True
        ckboGridType_S.Visible = True
        
        ckboGridType_N.Value = True
        ckboGridType_G.Value = True
        ckboGridType_GBG.Value = True
        ckboGridType_Contour.Value = True
        ckboGridType_S.Value = True
        
    End If
    
    Application.ScreenUpdating = True
End Sub
'---------------------------------------------------
Private Sub cmdAddConfig_Click()
'---------------------------------------------------
    
    
    'check values
    If cboGlassType.Value = "" Then
        MsgBox ("Choose a Glass Type")
        Exit Sub
    Else
        strGlassType = cboGlassType.Value
    End If
    
    If cboProductLine.Value = "" Then
        MsgBox ("Choose a Product Line")
        Exit Sub
    Else
        strProductLine = cboProductLine.Value
    End If
    
    If txtProductType.Value = "" Then
        MsgBox ("Enter a Product Type")
        Exit Sub
    Else
        strProductType = txtProductType.Value
    End If
    
    If cboPaneOptions.Value = "" Then
        MsgBox ("Choose a PaneOption")
        Exit Sub
    Else
        strPaneOptions = cboPaneOptions.Value
        
    End If
    
    
    If cboGlassType.Value <> "Monolithic" And cboGlassType.Value <> "Lami-PVB" _
                            And cboGlassType.Value <> "Lami-SGP" Then
        If txtAirSpace.Value = "" Then
            MsgBox ("Enter Air Space")
            Exit Sub
        Else
            strAirSpace = txtAirSpace.Value
        End If
    End If
    
        'check Grid Types
        strGridType = ""
        If ckboGridType_N.Value = True Then
            strGridType = "N,"
        End If
        
        If ckboGridType_G.Value = True Then
            strGridType = strGridType + "G,"
        End If
        
        If ckboGridType_GBG.Value = True Then
            strGridType = strGridType + "GBG,"
        End If
        
        If ckboGridType_Contour.Value = True Then
            strGridType = strGridType + "Contour,"
        End If
        
        If ckboGridType_S.Value = True Then
            strGridType = strGridType + "S,"
        End If
        
        'check if strGridType is null. if not remove last comma
        If strGridType = "" Then
            MsgBox ("Choose Grid Type")
            Exit Sub
        Else
            strGridType = Left(strGridType, Len(strGridType) - 1)
        End If
    
    
    'Add to Table
    ActiveSheet.ListObjects("tblConfigData").ListRows.Add
    
    'Product Line
    ActiveSheet.range("F" & ActiveSheet.ListObjects("tblConfigData").ListRows.Count + 1).Value = strProductLine
    'Product Type
    ActiveSheet.range("G" & ActiveSheet.ListObjects("tblConfigData").ListRows.Count + 1).Value = strProductType
    'PaneOptions
    ActiveSheet.range("H" & ActiveSheet.ListObjects("tblConfigData").ListRows.Count + 1).Value = strPaneOptions
    
    'AirSpace
    ActiveSheet.range("I" & ActiveSheet.ListObjects("tblConfigData").ListRows.Count + 1).Value = strAirSpace
    'GridType
    ActiveSheet.range("J" & ActiveSheet.ListObjects("tblConfigData").ListRows.Count + 1).Value = strGridType
    'GlassType
    ActiveSheet.range("K" & ActiveSheet.ListObjects("tblConfigData").ListRows.Count + 1).Value = strGlassType
End Sub
 
Private Sub tglSelectCHKBox_Click()
    If tglSelectCHKBox.Value <> True Then
    
        tglSelectCHKBox.Caption = "Deselect All"
        ckboGridType_N.Value = True
        ckboGridType_G.Value = True
        ckboGridType_GBG.Value = True
        ckboGridType_Contour.Value = True
        ckboGridType_S.Value = True
        
        If cboGlassType.Value = "Monolithic" Or cboGlassType.Value = "Lami-PVB" _
                            Or cboGlassType.Value = "Lami-SGP" Then 'Disable N/A attributes for Monolithic
            
            ckboGridType_GBG.Value = False
            ckboGridType_Contour.Value = False
            ckboGridType_S.Value = False
        End If
        
        
    Else
        tglSelectCHKBox.Caption = "Select All"
        ckboGridType_N.Value = False
        ckboGridType_G.Value = False
        ckboGridType_GBG.Value = False
        ckboGridType_Contour.Value = False
        ckboGridType_S.Value = False
    End If
End Sub
'---------------------------------------------------------------------
' Not used as of yet....
Public Function fzToggleControls(toggle As Boolean)
'---------------------------------------------------------------------
    Dim i As Long
    'checkboxes
    For i = 1 To ActiveSheet.OLEObjects.Count
        If TypeName(ActiveSheet.OLEObjects(i).Object) = "CheckBox" Then
            ActiveSheet.OLEObjects(i).Object.Value = toggle
            ActiveSheet.OLEObjects(i).Object.Visble = toggle
        End If
    Next i
    
    'labels
    lblAirSpace.Visible = toggle
    lblGridType.Visible = toggle
    
    'textbox
    txtAirSpace.Visible = toggle
End Function