VBA - Loop Current Region Multiple Times Before Moving On - excel

I have an HMI database dump that lists all available tags and I need to weed out the unused tags. I have separated each tag into its own region to try and make it somewhat easier. I want to see if a tag shows up on a window and/or if it is logged. Sometimes tags will be logged, but not used on a window and vice versa.
I created an if statement to check to find a cell that contains “WINDOWS:” and then copied that cell and all cells to the right of it to the next blank row on Sheet2. I also copied the tag name from the first cell in the area and pasted it to the next sheet. I am trying have the data formatted by the tag name then the associated attributes on the second sheet. I then created something very similar to check for “LOGGED:”.
The problem is that I need to loop through each individual area multiple times for it to search for both Windows and Logged and I am not sure how to do this. I also want to be able to eventually add more keywords to look for in the area after getting the base code worked out. I have tried multiple different nested if and for loops and I can't seem to get my code just right.
I used this as a starting point: Previously Asked Question
Here is my code:
Sub ZoneTest()
Dim Area As Range
Dim cell As Range
Dim lr As Long
Dim lc As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
'Looping through each block
For Each Area In Cells(lr, lc).SpecialCells(xlCellTypeConstants, 2).Areas
'Checking each cell
For Each cell In Area
If InStr(1, cell, "WINDOWS:") Then
Range(cell, cell.End(xlToRight)).Copy Sheets("Sheet2").Range("A:A").End(xlUp).Offset(2, 0)
Area.End(xlUp).Copy Sheets("Sheet2").Range("A:A").End(xlUp).Offset(1, 0)
End If
If CBool(InStr(1, cell.Value, "LOGGED:")) Then
If CBool(InStr(1, cell.Offset(0, 1).Value, "Yes")) Then
cell.Copy Sheets("Sheet2").Range("A:A").End(xlUp).Offset(4, 0)
Area.End(xlToLeft).Copy Sheets("Sheet2").Range("A:A").End(xlUp).Offset(3, 0)
End If
End If
Next cell
Next Area
End Sub
I am also attaching a screenshot of my Database so you can see the formatting I have.
Database Example

Related

Excel 2016 VBA , How to Insert Page Break on Every 2nd occurrence of particular text?

For example, on some sites,
I already study & try on Macro for insert HPageBreak Present on Every occurrence on particular text, with loop every cell of single column, but my requirement is every 2nd occurrence of particular txt
https://answers.microsoft.com/en-us/msoffice/forum/all/excel-macro-that-will-insert-horizontal-macros/9976e30a-8aae-4bec-84e8-43b35b113ec2
https://answers.microsoft.com/en-us/msoffice/forum/all/insert-dynamic-page-breaks-with-vba-for-excel/85790a6a-ef93-4354-8ad5-3cc5e4399285
https://www.extendoffice.com/documents/excel/1774-excel-insert-page-break-every-row.html
I already use Below code to put Hpagebreak on every found
but now requirement raise as every 2nd occurrence of "DISPATCH JAN TO NOV-22"
Sub Insert_Pagebreak_On_EveryFoundok()
Dim MYCOLUMN As Range
Dim MyCell As Range
'For Each MyCell In Range("G2:G" & Rows.Count).End.xlUp))
'For Each MyCell In Range Cells(Rows.Count, 2).End(xlUp).row 2
ActiveSheet.Range("G" & Rows.Count).End(xlUp).row))
ActiveWindow.view = xlPageBreakPreview
Set MYCOLUMN = ActiveSheet.Range("F2:F" & ActiveSheet.Range("F" & Rows.Count).End(xlUp).row)
For Each MyCell In MYCOLUMN
MyCell.Select
'If MyCell.Value Like "*Page 1 of 1*" Then
If MyCell.Value Like "*DISPATCH JAN TO NOV-22*" Then
ActiveCell.EntireRow.Select
ActiveWindow.SelectedSheets.HPageBreaks.Add
ActiveCell.offset(1, 0)
Else
ActiveCell.offset(1, 0).Select
End If
Next
ActiveWindow.view = xlNormalView
End Sub
This Loop check every cell that take more time, but I believe if use Range.Find method, then it can be more robust.
I am not knowing very well all aspects of VBA, but I daily use VBA in my many types of daily routine work & without it, I can't complete my work on time.
Currently I manually select 2 sets of data, adjust rows height to fit on A4, select -set-click print area & then print, and after print that I select below further 2 sets & do same thing, till sheet's data end,
painfully pass whole my day, just for print 2 data set on 1 A4 page.
There are need to beware for Hidden rows which hides for reason (not requirement in print). so, condition is only visible rows should be count for 2nd occurrence.
I attached Screen shot of whole scenario for reference.
[Plese Refer This Image as my situation]
enter image description here
Hundreds of data sets on this worksheet.
There should be 2 sets of data as pair require on every A4 size page.
so obviously page break requires on every 2nd occurrence of particular text.
If, that happen successfully, I am ready to manually adjust rows height to fit 2 sets in A4 page, so I get whole sheet ready for print in one go.
Hope, I try my best to describe my situation if require further, please mention.
Can anyone help regarding this?
I really appreciate & will be thankful forever.
Regards,
Chirag Raval

VBA - Excel - Finding the cell location of a userform TextBox populated by a for i loop?

What do I need to know?
How do I get the location of the data that a textbox is displaying? How do I know where it is?
What am I doing?
I have some code that loops through i and assigns it a value then pulls the cell value from a sheet based on i....so (i, 2) is simply: Row i from Column 2. This is then displayed in a userform Textbox.
What I want to do?
Add a dbl_click event, so that someone can double click on the textbox and be sent to the sheet/row/column that is being displayed. I have no issue creating the dbl_click event, but my problem appears to be how to get the cell location being displayed?
If it is relevant, this is my code for the loop:
Dim code as String
code = search.Value
For i = 2 To LastRow
If Sheet1.Cells(i, 9).Value = code Then
ssn1.Text = Sheet1.name
hb11.Text = Sheet1.Cells(i, 9).Value
End If
Next i
This is a snippet, as this goes on for awhile, hb11 runs though to hb37 - didn't see any reason to paste it all here.
The problem is, that the loop continues through, across multiple sheets as well, finding all examples of "code" so i keeps changing, after it has written the data to the TextBox - so I can't rely on (i, 9) from the loop.
I have gotten this far in terms of code:
Sub bt11_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If hb11.Value <> ("") Then
Application.Goto Reference:=Sheet1.Range(hb11)
End If
End Sub
However this appears to be relying on the value of hb11, rather than the cell location.
I know this is a dumb question, I know, but I just can't seem to find the answer?
I get the feeling that it lies in:
Dim cell as Range
Then:
Set cell = hb11.something
But I have been through the list, cell/range gives a mismatch, and don't actually exist in the list. There is no 'linked cell' as I thought that might do it...
I am a bit lost.
Profit from using the .Tag property
I'm assuming each of your 27 textboxes refers to exactly one source range address which consists of sheetname, row and column (or column character).
If so you can profit from assigning a combined reference string (e.g. "Sheet22" & "," & i & "," & 9) to a textbox'es ►.Tag property during the initializing loop, e.g. in a comma separated way like perhaps
hb11.Tag = "Sheet22,17,9" ' << i.e. sheet name, row 17, column 9
I think it'll be easy to get all data from there:
Dim src: src = split(hb11,",")
Application.Goto Reference:= _
ThisWorkbook.Worksheets(src(0)).Range(Cells(Val(src(1)), Val(src(2))).Address), Scroll:=True
Too many hours later, I have worked this out.
Thanks to T.M. for the idea about re-writing the data out of a stored place.
Outside of any sub, I created a String - right at the top.
Dim ac1 As String
Inside my loop, I simply gave ac1 the value of i,
For i = 2 To LastRow
If Sheet1.Cells(i, 9).Value = code Then
ssn1.Text = Sheet1.name
hb11.Text = Sheet1.Cells(i, 9).Value
ac1 = i
End If
Next i
This works, because you only run through this loop, IF code exists, since the list is unique, code only exists once. So you only go into the loop once, and when you do, i = the row.
Then using T.M.'s idea, I wrote out:
Application.Goto Reference:=Sheet1.Range("A" & ac1)
This is a range reference that Goto can handle.
The advantage of this method is, because I am searching multiple sheets with multiple Textboxes, I only need ac1 for a whole sheets worth of Textboxes.
Hope this helps someone in the future.

Copy and paste data based on text in cell next to it

I want the code to check every cell in in the range “A3:AAA3” for a specific text. If the cell contains that text, I want it to copy the text in the cell on the right, to two rows above (see below for illustration):
The copied text will be a date.
I have already got a piece of code which identifies every column with this text and sets the column width:
Dim c as Range
For Each c In Range("A3:AAA3").Cells
If c.Value = "TEXT" Then
c.EntireColumn.ColumnWidth = 4
End If
Next c
I can use copy and paste if the cell is already selected:
Dim s As Range
Set s = Selection.Cells(1)
s.Offset(0, 1).Copy
s.Offset(-2, 0).PasteSpecial xlPasteAll
And I feel like I should be able to combine the two into something like the below so that it selects the cell with the text, and copies and pastes the cell next to it, and then loops onto the next one (something like below?), but all my attempts aren’t working – it’s not coming up with an error message, just not doing anything.
Dim c As Range
For Each c In Range("A3:AAA3").Cells
If c.Value = "TEXT" Then
c.Select
c.Offset(0, 1).Copy
c.Offset(-2, 0).PasteSpecial xlPasteAll
End If
Next c
Thoughts? I’m sure it’s a very simple solution but I’m a bit stuck.
The c.Value = "TEXT" will check if the value is exactly TEXT but in your example it is 1 TEXT so it is only like TEXT. So we need to use a place holder and the like operator.
Dim c As Range
For Each c In Range("A3:AAA3").Cells
If c.Value Like "*TEXT*" Then
c.Offset(0, 1).Copy Destination:=c.Offset(-2, 0)
End If
Next c
Note that you can copy/paste in one line.
And you don't need c.Select (see How to avoid using Select in Excel VBA.)
Note that Excel does not know in which worksheet this range is Range("A3:AAA3").Cells better specify the worksheet like ThisWorkbook.Worksheets("MySheet").Range("A3:AAA3").Cells
Finally in all cases it is helpful if you debug your code step by step using F8 so you can see what your code does in every step and investigate the values of your variables to see where exactly it goes wrong.
Off Topic:
I would even prefer the following style:
c.Offset(ColumnOffset:=1).Copy Destination:=c.Offset(RowOffset:=-2)
which reads more intuitive.

How to loop through "blocks" of rows in excel dataset instead of each row individually (VBA)?

I'm trying to loop through a data set in Excel where the deciding factors for each block of rows is based on the second column (WO#) because I want to perform calculations (not part of this question) just for items in the same grouping.
Visualization on iterating through blocks of rows
Sub test()
Dim totalHrs As Integer, lastRow As Integer
Dim block As Range, dataSet As Range
lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Set dataSet = Range("A2:G" & lastRow)
For Each block In Columns("B").SpecialCells(xlCellTypeConstants, xlTextValues).Areas
'Do calculation stuff
Next block
End Sub
Right now I am having trouble defining what range 'block' should be since it will constantly change. A block begins when the "WO#" column is one number, and the block ends once that column's value changes to something else. How do I go about defining this range?
An easier way would be to just extract rows that have the same WO# into a new table and do the calculations there, but since this dataset can get quite large I would prefer not to do that as the macro will become way too heavy
What if you added this into G11 =IF(B11=B12,F12,C11) and then in F11 you added =G11-E11 and then dragged them down.
It should check to see if it's the last entry in the set and then set itself to the delivery date or set itself equal to the start day of the line below.
Edit:
Try replacing the F11 cell with this =WORKDAY(G11,-E11) and dragging down to account for workdays. To account for holidays, you can create a second sheet to list them out as dates and then add them as a range for the third, optional, argument in the Workday function. Please see the Workday documentation if more clarification is required on the function's use.
The code below defines blocks of similar values in a column. To use this code, either add a column to your worksheet combining columns B and C into one value (=B11&C11) or edit the code to check two columns (If rngCell.Offset(0, 0).Value = rngCell.Offset(1, 0).Value And rngCell.Offset(0, 1).Value = rngCell.Offset(1, 1).Value Then). Also, expand the blocks to more than one column.
'Starts the first block with the first cell in a column.
Set rngBlock = rngColumn.Cells(1)
'Checks every cell in a column.
For Each rngCell In rngColumn
'Checks whether a cell's value equals the cell below it.
If rngCell.Value = rngCell.Offset(1, 0).Value Then
Set rngBlock = Union(rngBlock, rngCell.Offset(1, 0))
'If equal, includes the cell below in the block.
Else
'If not equal, does something with the block...
Debug.Print rngBlock.Address
'Starts the next block with the cell below.
Set rngBlock = rngCell.Offset(1, 0)
End If
Next rngCell

Identifying text variables in lists in vba

I've been trying, unsuccessfully, for weeks to create a macro that loops through rows of text and identifies variable text phrases to sort products by there underlying components. That text phrase will be located in different spots across the page or linked with multiple other variables. For example how many products in a list contain "leather" and identify that in an answer row next to the list with a defined phrase like "Absolutely". The code I've been working with looks like this:
Sub Find()
Dim Sheet As Worksheet
Dim rng As Range
Dim row As Range
Dim cell As Range
Set Sheet = ActiveSheet
Set rng = Sheet.Range("E2:J7")
For Each row In rng.Rows
For Each cell In row.Cells
Select Case cell.Value
Case "Oil"
Case "Leather"
Cells(row.row, 11).Value = "Absolutely"
Case "Absolutely"
Case "Nope"
Case Else
Cells(row.row, 11).Value = "Nope"
End Select
Next cell
Next row
End Sub
And the Table would look look this:
Currently the code runs through the correct lines and sees all of the components but fails to identify the answers in the answer row. I'm using this code to hopefully identify many variable components in many product lists and "Leather" and "Oil" are currently just place holders. Hopefully this will help myself and many other people avoid reading long lists of data and marking individually whether or not each item meets a certain defined criteria.
Does this have to be VBA? You could easily do this with the COUNTIF function. Using your provided sample data, in cell D10 use this formula and copy down:
=IF(C10="","",IF(COUNTIF($2:$7,C10)>0,"Absolutely","Nope"))

Resources