Print from database using array but ignore certain columns on data

Question

I have a code which copies a line of data and pastes it into another sheet as an array, if a cell has been marked which a particular value (x) & then prints.

At the minute it copies the entire line of data, however I need it to ignore certain cells along that line of data.

Sub AlterQuote()
Dim FormWks As Worksheet
Dim DataWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim iCtr As Long
Dim myAddr As Variant
Dim lOrders As Long

Application.ScreenUpdating = False


Set FormWks = Sheets("Quote")
Set DataWks = Sheets("Quote Database")

myAddr = Array("G9", "G10", "G11", "G12", "C14", "C15", "C16", "C17", "C18", "C19", "C20", "C21", "B25", "C25", "D25", "E25", "F25", "G25", "H25", "I25", "H38", "I38", "B26", "C26", "D26", "E26", "F26", "G26", "H26", "I26", "H39", "I39", "B27", "C27", "D27", "E27", "F27", "G27", "H27", "I27", "H40", "I40", "B28", "C28", "D28", "E28", "F28", "G28", "H28", "I28", "H41", "I41", "B29", "C29", "D29", "E29", "F29", "G29", "H29", "I29", "H42", "I42", "I30", "H31", "H32", "H33", "H43", "I43", "H44", "H45", "H46", "D57", "D58", "D59", "D60")

With DataWks
  Set myRng = .Range("B3", _
    .Cells(.Rows.Count, "B").End(xlUp))
End With

For Each myCell In myRng.Cells
  With myCell
    If IsEmpty(.Offset(0, -1)) Then
  Else

      .Offset(0, -1).ClearContents
    
      For iCtr = LBound(myAddr) _
        To UBound(myAddr)
        FormWks.Range(myAddr(iCtr)).Value _
          = myCell.Offset(0, iCtr).Value
      Next iCtr

    End If
  End With
Next myCell

MsgBox "quote can now be altered on Quote Sheet"


    Application.ScreenUpdating = True

End Sub

I know it's within this line With DataWks Set myRng = .Range("B3", _ .Cells(.Rows.Count, "B").End(xlUp)) End With but I can't get it to work

Answer 1

Following on from my comment above: here is one solution which can also be used if you need to transfer data back to the database sheet.

Source Quote Database sheet with column mappings (Row 2 could be hidden if you think it's distracting):

Transfer code:

Sub AlterQuote()
    
    Const MAPPING_ROW As Long = 2
    Const DATA_ROW1 As Long = 4
    
    Dim FormWks As Worksheet, DataWks As Worksheet, myRng As Range, addr
    Dim rw As Range, rngMap As Range, c As Range, m As Variant, lr As Long
    
    Application.ScreenUpdating = False
    
    Set FormWks = ThisWorkbook.Worksheets("Quote")
    Set DataWks = ThisWorkbook.Worksheets("Quote Database")
    
    lr = DataWks.Cells(DataWks.rows.count, "A").End(xlUp).row
    If lr < DATA_ROW1 Then lr = DATA_ROW1 'in case no flag set...
    Set myRng = DataWks.Range("A" & DATA_ROW1 & ":A" & lr)
    
    m = Application.match("*", myRng, 0) 'find first value in myRang
    
    If Not IsError(m) Then                'found a flag?
        Set rw = myRng.Cells(m).EntireRow 'the flagged row
        
        With DataWks           'get the range with cell mappings
            Set rngMap = .Range(.Cells(MAPPING_ROW, 1), _
                        .Cells(MAPPING_ROW, .Columns.count).End(xlToLeft))
        End With
        
        For Each c In rngMap.Cells  'loop over the mapping row cells
            addr = c.Value
            If Len(addr) > 0 Then   'does this column get mapped?
                FormWks.Range(addr).Value = rw.Cells(c.Column).Value
            End If
        Next c
        myRng.Cells(m).ClearContents 'clear flag
        MsgBox "quote can now be altered on Quote Sheet"
    Else
        MsgBox "No row is flagged"
    End If
    Application.ScreenUpdating = True
End Sub

Resulting output on Quote worksheet:

Another approach might be to create a "mapping" worksheet with a table of column headers and destination addresses.