Checklists data changes with each print per specific equipment

slayer1957

Board Regular
Joined
Jan 9, 2017
Messages
50
Good day,
I have a three checklists with a lot of checks for a specific equipment, Sheet 1, 2 and 3.

The only cell value that should change on the checklist is the equipment number which is in cell A3.

When i run the print macro, it should print out (a preview) the checklist based on the marked X in columns changing only the cell value A3 on the checklists, equipment number from column A1 on the data entry sheet up to end of row where no values are present.

This checklists is sheet 1;2 and 3, the only cell value that should change when i run the macro is cell A3 depending on the (data) worksheet from cells A1. So if the cell is marked with an X in checklist 1 column it should print preview sheet 1 and change the cell value A3 to 210PC-2501M. This should continue with 2nd print sheet 2 (checklist 2) with equipment number 210HV-25002M, then third print checklist 3 (sheet 3) and then lastly checklist 1 again with number 210pc-3301M.

Then i will have 4 printouts i can make part of the inspection file each with different checks but from one sheet i can control.

Please assist with this if you can. Please also make small notes in the vba code so that i can understand the coding, this is only if you want to, otherwise i will manage it from google search to learn.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Equipment Column A1[/TD]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD="width: 137"]Description:[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]Checklist 1[/TD]
[TD]Checklist 2[/TD]
[TD]Checklist
3[/TD]
[/TR]
[TR]
[TD][TABLE="width: 251"]
<tbody>[TR]
[TD="width: 251"]210PC-2501M[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD="width: 137"]Wash Coolers[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]X[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][TABLE="width: 251"]
<tbody>[TR]
[TD="width: 251"][TABLE="width: 251"]
<tbody>[TR]
[TD="width: 251"]210HV-25002M[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD="width: 137"]Oxygen[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD]X[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][TABLE="width: 251"]
<tbody>[TR]
[TD="width: 251"]210GB-2501 AM & BM[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD="width: 137"]Grate[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD][/TD]
[TD]X[/TD]
[/TR]
[TR]
[TD][TABLE="width: 251"]
<tbody>[TR]
[TD="width: 251"]210PC-3301M[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]Wash Coolers[/TD]
[TD]X[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I have found a link with some good vba https://www.contextures.com/xlForm03.html which can be used but i think it is partly copyrighted as i cannot edit the vba as the tables are missing or i am just not well experienced how to read the vba code then.

This is some code that might be helpfull but i cant get it ot work as i need,
Code:
[COLOR=#333333][FONT=Menlo]Option Base 0[/FONT][/COLOR]Sub PrintUsingDatabase()
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

Set FormWks = Sheets("Order Form")
Set DataWks = Sheets("Orders")

myAddr = Array("E5", "E6", "B10", _
  "E25", "B16", "C16", "D16")

With DataWks
  'first row of data to
  '  last row of data in column B
  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
      'if the row not marked, do nothing
    Else
      'clear mark for the next time
      .Offset(0, -1).ClearContents
      For iCtr = LBound(myAddr) _
        To UBound(myAddr)
        FormWks.Range(myAddr(iCtr)).Value _
          = myCell.Offset(0, iCtr).Value
      Next iCtr
      Application.Calculate 'just in case
       'after testing, change Preview
       '  to False to Print
      FormWks.PrintOut Preview:=True
      lOrders = lOrders + 1
    End If
  End With
Next myCell

MsgBox lOrders & " orders were printed."
 [COLOR=#333333][FONT=Menlo]End Sub[/FONT][/COLOR]

or this which marks with an X the sheet you want to print

Code:
Sub ClearMarks()  Worksheets("Orders") _
    .Range("OrdersPrint") _
      .ClearContents
End Sub
Sub PrintMarkedOrders()
    Dim wsO As Worksheet
    Dim wsOF As Worksheet
    Dim rngONS As Range
    Dim rngOP As Range
    Dim c As Range
    Dim lPrint As Long
    Dim lOrders As Long
    Dim bPreview As Boolean
    Dim lClear As Long


    Set wsO = Worksheets("Orders")
    Set wsOF = Worksheets("Order Form")


    Set rngONS = wsOF.Range("OrderNumSel")
    Set rngOP = wsO.Range("OrdersPrint")
    
    lPrint = MsgBox("Click Yes to Print" _
      & vbCrLf _
      & "Click No to Preview" _
      & vbCrLf _
      & "Click Cancel to Exit", _
      vbQuestion + vbYesNoCancel + vbDefaultButton2, _
      "Print or Preview")


  Select Case lPrint
    Case vbYes
      bPreview = False
    Case vbNo
      bPreview = True
    Case Else
      Exit Sub
  End Select
  
  For Each c In rngOP
    If IsEmpty(c) Then
      'if row not marked, do nothing
    Else
      rngONS.Value = c.Offset(0, 1).Value
      Application.Calculate 'just in case
      wsOF.PrintOut Preview:=bPreview
      lOrders = lOrders + 1
    End If
  Next c
  
  Select Case lOrders
    Case 1
      MsgBox lOrders & " order was printed."
    Case Else
      MsgBox lOrders & " orders were printed."
  End Select
  
  lClear = MsgBox("Clear the print marks?", _
      vbQuestion + vbYesNo + vbDefaultButton2, _
      "Clear Marks?")
  
  If lClear = vbYes Then
    rngOP.ClearContents
  End If
End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

Forum statistics

Threads
1,223,894
Messages
6,175,250
Members
452,623
Latest member
Techenthusiast

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top