Same Userform, Different Lines

[cpounds217]

Hi All!

I am back with a new project, and I am stymied on how to get this to work.

I have a worksheet:
21746

Each of those buttons opens the SAME userform, and fills the Label (MEFLabel.Caption), with the value in Column A:
21747

My goal is have the values of the checkboxes located on the userform returned if checked in the userform. These values would be returned to the row of the "captured" Label Caption, and would start Column F and continue over. Of course the checkboxes wont always refer to the same cell, because if it isnt checked, then the next checked box could go there (minimizing the width of the sheet).

Also the Userform changes based on answers to a prior sheet, so there are a total of 26 potential hazards.

My pathetic attempt at the code is below:

Private Sub AddButton_Click()

Call AddValues

Unload Me


' Below was a different attempt


' Dim found As Range
' Dim str As String
'
' str = Me.MEFLabel.Caption
' Set found = wsBIA2.Range("A2", Range("A" & Rows.Count).End(xlUp)).Find(str)
'
' If found Is Nothing Then
' Exit Sub
' Else
' ActiveCell = found
' With wsBIA2
' .ActiveCell.Offset(0, 1) = YesOrNo(Drought.Value)
' .ActiveCell.Offset(0, 2) = YesOrNo(Earthquakes.Value)
' .ActiveCell.Offset(0, 3) = YesOrNo(Temperatures.Value)
' .ActiveCell.Offset(0, 4) = YesOrNo(Flooding.Value)
' .ActiveCell.Offset(0, 5) = YesOrNo(SevereWx.Value)
' .ActiveCell.Offset(0, 6) = YesOrNo(TropCyclones.Value)
' .ActiveCell.Offset(0, 7) = YesOrNo(Landslides.Value)
' .ActiveCell.Offset(0, 8) = YesOrNo(Pandemic.Value)
' .ActiveCell.Offset(0, 9) = YesOrNo(SevereWinter.Value)
' .ActiveCell.Offset(0, 10) = YesOrNo(Wildfire.Value)
' .ActiveCell.Offset(0, 11) = YesOrNo(Shooter.Value)
' .ActiveCell.Offset(0, 12) = YesOrNo(Crime.Value)
' .ActiveCell.Offset(0, 13) = YesOrNo(BioAgent.Value)
' .ActiveCell.Offset(0, 14) = YesOrNo(CyberIncident.Value)
' .ActiveCell.Offset(0, 15) = YesOrNo(Terrorism.Value)
' .ActiveCell.Offset(0, 16) = YesOrNo(InFlooding.Value)
' .ActiveCell.Offset(0, 17) = YesOrNo(InHazMat.Value)
' .ActiveCell.Offset(0, 18) = YesOrNo(ExHazMat.Value)
' .ActiveCell.Offset(0, 19) = YesOrNo(Fire.Value)
' .ActiveCell.Offset(0, 20) = YesOrNo(RadioRelease.Value)
' .ActiveCell.Offset(0, 21) = YesOrNo(LongPowerFailure.Value)
' .ActiveCell.Offset(0, 22) = YesOrNo(HVACFailure.Value)
' .ActiveCell.Offset(0, 23) = YesOrNo(PowerFailure.Value)
' .ActiveCell.Offset(0, 24) = YesOrNo(UtilityFailure.Value)
' .ActiveCell.Offset(0, 25) = YesOrNo(CommsFailure.Value)
' .ActiveCell.Offset(0, 26) = YesOrNo(ITFailure.Value)
' End With
' End If

End Sub


Private Function AddValues()


Dim emptyRow As Long
Dim ws As Worksheet
Dim str As String
Dim lrow As Long

str = Me.MEFLabel.Caption
Set ws = wsBIA2

On Error Resume Next
lrow = Application.WorksheetFunction.Match(str, ws.Range("A2:A300"), 0)

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If Drought.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N33")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If Earthquakes.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N34")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If Temperatures.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N35")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If Flooding.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N36")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If SevereWx.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N37")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If TropCyclones.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N38")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If Landslides.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N39")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If Pandemic.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N40")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If SevereWinter.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N41")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If Wildfire.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N42")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If Shooter.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N43")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If Crime.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N44")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If BioAgent.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N45")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If CyberIncident.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N46")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If Terrorism.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N47")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If InFlooding.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N48")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If InHazMat.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N49")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If ExHazMat.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N50")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If Fire.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N51")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If RadioRelease.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N52")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If LongPowerFailure.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N53")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If HVACFailure.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N54")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If PowerFailure.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N55")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If UtilityFailure.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N56")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If CommsFailure.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N57")
End If

emptyRow = Range("F:AE").Cells.SpecialCells(xlCellTypeBlanks).Column

If ITFailure.Value = True Then
ws.Cells(lrow, emptyRow) = Sheet28.Range("N58")
End If

End Function

[SamT]

Is "wsBIA2" the Name of a worksheet, or the CodeName of a Worksheet.

Sheet Names can be seen on the Sheet Tab.

Sheet CodeNames can only be seen in the VBA Editor's Project Explorer Window and Properties Window.

CodeNames and Names are treated differently in VBA code.

CodeNames are sometimes referred to as Object names, and Names are sometimes called Tab names.

[Paul_Hossler]

It'd be easier to review if you could attach a sample workbook with the worksheet, user form, and macro

[cpounds217]

I know that, but I am not allowed to put this out. In fact, the use of it by agencies within my state will be limited and oversaw by my colleagues. So I cannot upload. And that will remain the case for any, and every, work related application and coding question I have.

Sorry!

[SamT]

Is "wsBIA2" the Name of a worksheet, or the CodeName of a Worksheet.

[cpounds217]

That is the codename.

I use a worksheet naming convention of ws***** with the stars being the same as the Worksheet Name.

[SamT]

That is the codename.

I use a worksheet naming convention of ws***** with the stars being the same as the Worksheet Name
So the "Tab" name is "B1A2" and the CodeName is "wsB1A2"?
Excellent Coding procedure.


This is off the top of my head and was not typed in the VBA Editor, so it can have unchecked errors.

Private Sub AddHazards()
'Requires the String "Hazard" added to the Tag property of each "Hazard" CheckBox.
'This "Tagging" method allows non "Hazard" Controls to be used on the Form

Dim Hazards as Variant
Dim Ctrl As Object

Redim Hazards(1) 'setup the array

For Each Ctrl in Me.Controls
If Ctrl.Tag = "Hazard" Then
If Ctrl = True Then
Hazards(UBound(Hazards)) = Ctrl.Caption
Redim Preserve Hazards(Ubound(Hazards) + 1)
End If: End If
Next

'Your code from above
Set found = wsBIA2.Range("A:A").Find(str)

If Not Found Is Nothing Then _
Found.Offset(0, 5).Resize(1, Ubound(Hazards) = Hazards
End Sub

[cpounds217]

I haven't been able to test this yet, but I had another time-sensitive project come up, as well as three nor'easters back to back to back. So little busy, haha. Please DO NOT mark this as solved yet. I will try and follow-up next week if I can.

Thank you!