PDA

View Full Version : [SOLVED] How to modify this code to place the checkbox in the first cell of each column?



ajjava
04-30-2019, 09:19 AM
I have the following code that goes sheet by sheet, looking for the word "Total" or "Incurred". Once found, a checkbox is added next to the found word. I've been pulling my hair out trying to figure out to have the checkbox INSTEAD get added to the first cell in the column in which "total" appears. See code and pic showing what I mean. I feel like it's an obvious change to the code, but I'm missing it.

24167


'These are "target" words found in the tables, which dictate where the checkboxes will be added findWords = Array("Total", "Incurred")


Set r = currentSheet.Range("A2:EE100") 'UsedRange


For Each word In findWords 'Any time one of the findWords words is identified, a checkbox is placed in a position relative to that cell
Set b = r.Find(word, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

If Not b Is Nothing Then
celda = b.Address

Do

Set chkbx = currentSheet.CheckBoxes.Add(Left:=b.Left + 5, Top:=b.Top, Width:=25, Height:=0)
With chkbx
.Caption = "Select"
.Left = b.Left + b.Width - 60
End With
Set b = r.FindNext(b)
laphoja = currentSheet.Name
Loop While Not b Is Nothing And b.Address <> celda
End If


Next word

End If
Next currentSheet

georgiboy
04-30-2019, 11:52 AM
Try changing:

Top:=b.Top

To maybe the number 5, see what number suits.
This is the part that sets the top of the checkbox.

Hope this helps

ajjava
04-30-2019, 12:42 PM
I've managed to move it closer, by changing random numbers to, well, random OTHER numbers. Any ideas on how to move it more towards the edge of each boxed region?
This code produced what you see here (below):


'These are "target" words found in the tables, which dictate where the checkboxes will be added findWords = Array("Total", "Incurred")


Set r = currentSheet.Range("A2:EE100") 'UsedRange


For Each word In findWords 'Any time one of the findWords words is identified, a checkbox is placed in a position relative to that cell
Set b = r.Find(word, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

If Not b Is Nothing Then
celda = b.Address

Do
Set chkbx = currentSheet.CheckBoxes.Add(Left:=5, Top:=230, Width:=65, Height:=0)
' Set chkbx = currentSheet.CheckBoxes.Add(Left:=b.Left + 10, Top:=b.Top + 5, Width:=25, Height:=0)
With chkbx
.Caption = "Select"
.Left = b.Left - 10 + b.Width - 60
End With
Set b = r.FindNext(b)
laphoja = currentSheet.Name
Loop While Not b Is Nothing And b.Address <> celda
End If


Next word

End If

24168

georgiboy
04-30-2019, 10:12 PM
Try something like:

Sub test()
Dim findWords As Variant
Dim r As Range, cBoxCell As Range, b As Range
Dim word, celda As String, laphojaa As String
Dim chkbx As Object
Dim currentSheet As Worksheet

Set currentSheet = Sheet1

findWords = Array("Total", "Incurred")

Set r = currentSheet.Range("A2:EE100")


For Each word In findWords
Set b = r.Find(word, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

If Not b Is Nothing Then
celda = b.Address
Set cBoxCell = currentSheet.Cells(2, b.Column)

Do
Set chkbx = currentSheet.CheckBoxes.Add(cBoxCell.Left + 1, cBoxCell.Top + 1, Width:=65, Height:=0)
chkbx.Caption = "Select"
Set b = r.FindNext(b)
laphoja = currentSheet.Name
Loop While Not b Is Nothing And b.Address <> celda
End If
Next word
End Sub

You were setting the left property of the checkbox twice, only the second one counted.

Hope this helps

ajjava
05-01-2019, 06:11 AM
Ok, progress. The positioning is perfect, but for some reason that I can't identify, it won't loop through the whole worksheet anymore. It puts one checkbox in the desired location and then stops. Could it perhaps be this line causing the issue:

Set cBoxCell = currentSheet.Cells(2, b.Column)

24169

georgiboy
05-01-2019, 07:49 AM
My mistake, you are right.

That line needs to go inside the do loop:

Do
Set cBoxCell = currentSheet.Cells(2, b.Column)
Set chkbx = currentSheet.CheckBoxes.Add(cBoxCell.Left + 1, cBoxCell.Top + 1, Width:=65, Height:=0)
chkbx.Caption = "Select"
Set b = r.FindNext(b)
laphoja = currentSheet.Name
Loop While Not b Is Nothing And b.Address <> celda

Hope this helps

ajjava
05-01-2019, 08:47 AM
PERFECTION!! Thank you very much for your help!!

ajjava
05-13-2019, 06:13 AM
georgiboy - in case you don't notice it, I've sent you a private message about the above code that you helped me with. I just need your help in troubleshooting the behavior of the code when the source data is slightly different (I didn't expect that the layout of the data would matter much with this script, but it evidently does). THANK YOU!!

georgiboy
05-13-2019, 11:16 PM
Hi Ajjava,

I have had a look at my private messages, the code you have sent me along with the issue you are describing does not have any resemblance to the above piece of code.
The code above does not copy or paste any pictures or data so i am unsure of what you are implying.
Are you stating that the above code is having a negative impact on current code in the workbook or is what is in the private messages a separate issue?

Thanks

ajjava
05-14-2019, 04:09 AM
My apologies - I received help on this same procedure from another forum user, and it appears that I've confused the two of you. Thank you for checking and sorry for the confusion.