I have very basic knowledge in VBA, I have one requirement where the data for a specific set will be available in multiple rows and it will be like Header (ex. from A to D) and lines (ex. from E:J). Header will not be there for all the line rows, so when validating the line data with Header data, I need to validate the value in for ex. col "D2" with all the lines and when the new header is available, follow the same pattern again.
Below is the sample data format, in which col "A:D" represents Header data and from col "E:J" represents line data. Through out the line validation with Header, I want col "D" value to be captured through out that iteration.
Ex. When the "ABC" value is iterated, "PO1" should be available for validation for rows "E2:J4". After this iteration and when the new value on Col A, i.e "DEF" is encountered then the value in Col "D" to be changed like "PO2" from the next 2 rows of the Header.
As I have very basic knowledge in VB, not sure how I can achieve this. Can anyone help me here please?
I tried to compare the first value with the next available value in Col A, during this iteration tried storing the Col "D" value to a global variable but it is not giving me expected results
Sample code that i tried:
Public v As Integer
Sub inv()
Dim i As Integer, j As Integer, temp As Integer, rng As Range
Dim lastRow As Integer, lastRowSheet2 As Integer
Dim sheet1 As Worksheet, Sheet2 As Worksheet
Set sheet1 = Sheets("Data")
Set Sheet2 = Sheets("res")
lrow = sheet1.Range("A1").SpecialCells(xlCellTypeLastCell).Row
For i = 2 To lrow
If sheet1.Range("A" & i).Value <> "" Then
invv = sheet1.Range("A" & i).Value
v = i
End If
If sheet1.Range("A" & i + 1).Value <> "" Then
ninv = sheet1.Range("A" & i + 1).Value
End If
If invv <> ninv And sheet1.Range("A" & i + 1).Value <> "" Then
Sheet2.Range("A" & i).Value = sheet1.Range("D" & v).Value
MsgBox "Alert -Entry in row is not equal to Previous Cell !!"
'Exit Sub
End If
Next i
End Sub
... and what about filling in those values, like I did in this example:
Select all data (Ctrl+G, Special, Current Region).
In there, select all blanks (Ctrl+G, Special, Blanks).
Copy the value from the one above (F2, fill in =A2).
Fill in for all select (blank) cells (Ctrl+ENTER)
This is what you end up with:
Related
Attempting to write some vba but not having much luck. I have column A with a whole list of values that I am counting and looping through. For Each value in column A, there can be a match in range C:D. If a value in column A matches a value in column C. I want to insert the corresponding value in column D below the Column A value. I am not too certain on what my IF then statement should look like. I have my counter and loop... I am just unsure where to go with the middle portion of the code.
Sub SetListOrder()
Dim wp As Worksheet
Dim ef As Long
Set wp = Workbooks("Packing Slip FIXED").Worksheets("Locate Order")
ef = wp.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To ef
IF (UNSURE WHAT TO PLACE HERE!) THEN
Next i:
End Sub
Edit: adding sample data
Sample Data screenshot
In this example, I would like to insert a new row under the value in "A" where A=C. ie. Range in column "A" = Range in Column "C". I would like to then insert the value from "D". The new order in rows 4-6 would be:
Range
Order Group 1
2604291
I already have written the code to manually move my sheets around to follow the specific order once I am able to get the names in said order.
I agree with #BigBen that the simpler approach would be to insert a formula in column D that only replicates the column A value when a match is detected. Such a formula would probably look like the following -
=IF($A1=$C1,$A1,"")
This would be copied into cell D2 of your column and copied down as far as needed.
However, if you did want to achieve this with VBA and I have noted you used the word insert a value (as opposed to simple enter a value or copy & paste a value) then this could be your approach -
Sub SetListOrder()
Dim wp As Worksheet
Dim ef As Long
Dim i As Long
Set wp = Workbooks("Packing Slip FIXED").Worksheets("Locate Order")
ef = wp.Range("A" & Rows.Count).End(xlUp).Row
For i = ef To 1 Step -1
If wp.Range("A" & i).Value = wp.Range("C" & i).Value Then
wp.Range("D" & (i + 1)).Insert xlShiftDown
wp.Range("D" & (i + 1)).Value = wp.Range("A" & i).Value
Else
End If
Next i
End Sub
This approaches the problem in reverse by going up your column instead of going down. Note that by inserting your data, will cause each previous value to move down as well. If you don't want this, then simply erase the .Insert line and it will enter the value instead of inserting a cell.
Modify the below code and use:
Formula:
=IFNA(VLOOKUP(A1,$C$1:$D$5,2,0),"Missing")
VBA Code:
Option Explicit
Sub test()
Dim rngSearch As Range, rngFound As Range
Dim LastRowA As Long, LastRowC As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
LastRowC = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rngSearch = .Range("C1:D" & LastRowC)
For i = 1 To LastRowA
Set rngFound = rngSearch.Find(.Range("A" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)
If Not rngFound Is Nothing Then
.Range("B" & i).Value = .Range("D" & rngFound.Row).Value
Else
.Range("B" & i).Value = "Missing"
End If
Next i
End With
End Sub
Result:
Here is a sample of the report I have:
Basically the report consists in a huge list of suppliers where among other things, I need to identify which of them have all entities (content groups) for the same country, while ignoring the "integrate" tag. Entities for each country are defined in a table separately (right).
So far I tried a combination of =SUMPRODUCT(--(ISNUMBER(SEARCH())) but always getting partially what I want.
In column C, in need:
to display YES if the supplier on that row has all entities for the mentioned country code;
to display NO otherwise;
My logic on this:
The formula/s needs to pick the country code from 1st table, then look into the 2nd table where entities are defined and check if all the entities in the content group are matching, ignoring "integrate" which is a default tag applied everywhere.
Expected result:
Try:
Option Explicit
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim LastRowA As Long, i As Long, y As Long
Dim arr As Variant
Dim CountryCode As String
Dim rng As Range, SearchRange As Range, FindPosition As Range
Dim Appears As Boolean
'Set worksheets on variables
With ThisWorkbook
Set ws1 = .Worksheets("Sheet1")
Set ws2 = .Worksheets("Sheet2")
End With
'Set the range to search in for country codes
Set SearchRange = ws2.Range("H1:R1")
With ws1
'Find the last row of Column A sheet1
LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
'Start loop from row 2 to last row sheet1
For i = 2 To LastRowA
'Criteria needed ( Column A - Not empty cell, Column D - Includes "Europe" & Column E - Includes "No" Columns D and E are CASE SENSITIVE)
If .Range("A" & i).Value <> "" And .Range("D" & i).Value = "Europe" And .Range("E" & i).Value = "No" Then
CountryCode = .Range("B" & i).Value
'In which column the country code found
Set FindPosition = SearchRange.Find(What:=CountryCode, LookIn:=xlValues, LookAt:=xlWhole)
'If code excist
If Not FindPosition Is Nothing Then
'Set the range to search for the groups in the column where the code is header
Set rng = ws2.Range(ws2.Cells(2, FindPosition.Column), ws2.Cells(ws2.Cells(ws2.Rows.Count, FindPosition.Column).End(xlUp).Row, FindPosition.Column))
'Split the string with comma and assing it on arr
arr = Split(.Range("A" & i).Value)
Appears = False
'Loop the arr
For y = LBound(arr) To UBound(arr)
'Check if the arr(y) start from C as all code start from C
If Left(arr(y), 1) = "C" Then
'Count how many times the arr(y) with out the comma appears in the rng
If Application.WorksheetFunction.CountIf(rng, Replace(arr(y), ",", "")) > 0 Then
'If appears the variable Appears is true
Appears = True
Else
'If does not appear the variable Appears is False & Exit the loop
Appears = False
Exit For
End If
End If
Next y
'Check Appears variable status and import value in Column C
If Appears = True Then
.Range("C" & i).Value = "Yes"
Else
.Range("C" & i).Value = "No"
End If
'If code does not excist
Else: MsgBox "Country Code not does not excist."
End If
End If
Next i
End With
End Sub
If you have a version of Excel 2013+ which has the FILTERXML function, you can use this array formula:
=IF(OR(ISNA(MATCH(FILTERXML("<t><s>"&SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A2,"Integrate",""),", ",","),",","</s><s>")&"</s></t>","//s"),INDIRECT("Table2["&B2&"]"),0))),"No","Yes")
We remove the Integrate
Create an XMLfrom the strings in Table1
Extract each element of the XML
Try to find them in the appropriate column of Table2
If we don't find one, then it has multiple countries.
Since this is an array formula, you need to "confirm" it by holding down ctrl + shift while hitting enter. If you do this correctly, Excel will place braces {...} around the formula as observed in the formula bar
If you have a version of Excel that does not have this function, and you are still interested in using excel formulas as opposed to VBA, there is another formula we can use.
I have a spreadsheet that has 29 columns of headers in row 6. Underneath the 29 headers, there is numerical data that extends to 10000 rows. I want to select a header and then enter a minimum value and a maximum value and any data that exceeds the maximum, or is lower than the minimum for that header column, the row that violates the criteria gets deleted.
I was thinking of a user inputting a minimum and a maximum value in cell A1 and A2 then selecting a header from a drop down box then it runs and removes the rows that violate the boundary conditions. So far I have this.
Sub deleterows()
Application.ScreenUpdating = False
Dim Min As Integer
Dim Max As Integer
Dim i As Integer
Dim HeaderRange As Range
Dim matchval As Double
Dim str As String
'Finding column number for the header
'Header is selected in Row 3, headers for the data is in row 6
matchval = Application.Match(Range("A3"), Range("A6:AC6"), 0)
str = Split(Cells(, matchval).Address, "$")(1)
Set HeaderRange = Range(str & "6:" & str & Cells(6, Columns.Count).End(xlToLeft).Column).Find(What:=str, lookat:=xlWhole)
If Cells(1, 1).Value <> "" And IsNumeric(Cells(1, 1)) Then
Min = Cells(1, 1).Value
End If
If Cells(2, 1).Value <> "" And IsNumeric(Cells(2, 1)) Then
Max = Cells(2, 1).Value
End If
For i = Cells(Rows.Count, HeaderRange.Column).End(xlUp).Row To 7 Step -1
If Cells(i, HeaderRange.Column).Value > Max Or Cells(i, HeaderRange.Column).Value < Min Then
Rows(i).EntireRow.Delete
End If
Next i
End Sub
Basically, I'm finding the position of the Header and then finding the address, converting it into a string then using the Column index for that header. Then it finds any cell that violates the minimum and maximum condition and deletes it.
However, when I try running this, I run into errors when I'm trying to use headers that have more than a single character. So if I have a header called "V" it runs fine, however if I have one called "Vradial", I get an error saying "Run-time error '91': Object variable or With block variable not set" for line:
For i = Cells(Rows.Count, HeaderRange.Column).End(xlUp).Row To 7 Step -1
Any help would be greatly appreciated.
Thanks!
I found the answer for your direct question "Why only single character headers work". I also noticed that you have an unnecessary redundancy in the code (already mentioned/noticed in the comments by the user "eirikdaude")
"Why only single character headers work"
When using the Find(What:=str) in the code below, you are finding a letter only (the alphabetic column identifiers). What you should be finding/searching for, is the value (actual text) of the header that is written in the sheet
Set HeaderRange = Range(str & "6:" & str & Cells(6,
Columns.Count).End(xlToLeft).Column).Find(What:=str, lookat:=xlWhole)
You can write the line as follows: (I tested it and works)
Set HeaderRange = Range(str & "6:" & str & Cells(6,
Columns.Count).End(xlToLeft).Column).Find(What:=Range("A3"), lookat:=xlWhole)
"Unnecessary Redundancy in the Code"
The above correction while it works, is unnecessary. If I am not mistaken the code line with the issue is used to find the header column. If so, you already find the correct header column index from the code below.
matchval = Application.Match(Range("A3"), Range("A6:AC6"), 0)
'This is only the correct header column index because the match/search range starts from column "A"
Hence, you can disregard the line that is giving you trouble and write the code as follows: (And do not forget to set Application.ScreenUpdating=True at the end ;D)
Sub deleterows()
Application.ScreenUpdating = False
Dim Min As long 'if you expect the min or max to have decimals use Double or Single rather than Long
Dim Max As long
Dim i As long 'I changed from Integer to Long because 99% of the time Long is better than Integer
Dim matchval As long 'application.match returns a position in an array. Hence Long/Integer are better than Double
'Finding column number for the header
'Header is selected in Row 3, headers for the data is in row 6
matchval = Application.Match(Range("A3"), Range("A6:AC6"), 0)
If Cells(1, 1).Value <> "" And IsNumeric(Cells(1, 1)) Then
Min = Cells(1, 1).Value
End If
If Cells(2, 1).Value <> "" And IsNumeric(Cells(2, 1)) Then
Max = Cells(2, 1).Value
End If
For i = Cells(Rows.Count, matchval).End(xlUp).Row To 7 Step -1
If Cells(i, matchval).Value > Max Or Cells(i, matchval).Value < Min Then
Rows(i).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
Hope this helps you.
I am trying to create a summary list for people in a downstream application to feed several of my production machines. Each machine is going to have their own tab to request material, and I want all of their requests to be summarized on one tab (called "Core_Cutter_List").
So basically I am trying to create a VBA that will copy over a row from spreadsheet "2" into the next blank line on spreadsheet "Core_Cutter_List". I want it to copy if there is text in column A and column G is blank. I have limited knowledge of VBA. The code that I found was able to only test for one of my criteria which was that column G is blank, but basically it runs through every single cell on my file. Do you know how I can add the other criteria of column A having text in it so that it doesn't look through every cell on my sheet? Thanks for any help!
Sub Test()
'
' Test Macro
'
Sheets("2").Select
For Each Cell In Sheets(1).Range("G:G")
If Cell.Value = "" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("Core_Cutting_List").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("2").Select
End If
Next
End Sub
If you need two conditions, then you should write them carefully in the IF statement with And:
Something like If cell.Value = "" And Len(cell.Offset(0,-6)) Then should be workable.
Using Select is a bit not advisable, but it works at the beginning - How to avoid using Select in Excel VBA
The Sub bellow does the following
Determine the last used row in Worksheets("2") based on values in column A
Determine the last used col in Worksheets("2") based on values in row 1
Determine the last used row in Worksheets("Core_Cutter_List") based on values in column A
Loop through all used rows in Worksheets("2")
If the cell in col A is not empty And cell in col G is empty
Copy entire row to next empty row in Worksheets("Core_Cutter_List")
Increment next empty row for Worksheets("Core_Cutter_List")
Loop to the next used row in Worksheets("2")
Option Explicit
Public Sub CopyRows()
Dim ws1 As Worksheet, ws2 As Worksheet, ws1r As Range, ws2r As Range
Dim ws1lr As Long, ws1lc As Long, ws2lr As Long, i As Long
Set ws1 = ThisWorkbook.Worksheets("2")
Set ws2 = ThisWorkbook.Worksheets("Core_Cutter_List")
ws1lr = ws1.Range("A" & Rows.Count).End(xlUp).Row 'last row in "2"
ws1lc = ws1.Cells(1, Columns.Count).End(xlToLeft).Column 'last col in "2"
ws2lr = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1 'last row in "Core_Cutter"
For i = 1 To ws1lr
If Len(ws1.Cells(i, "A")) > 0 And Len(ws1.Cells(i, "G")) = 0 Then
Set ws1r = ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, ws1lc))
Set ws2r = ws2.Range(ws2.Cells(ws2lr, 1), ws2.Cells(ws2lr, ws1lc))
ws2r.Value2 = ws1r.Value2
ws2lr = ws2lr + 1
End If
Next i
End Sub
My test file
Worksheets("2")
Worksheets("Core_Cutter_List")
I have a userform in which user can insert data and data will insert in column B to M. I need a code, either in worksheet or in userform to auto fill serial number starting with "RD 00001" which will fill in column A everytime data has enter. Please someone give me an idea.
The code behind this is very simple and designed for you to start on a blank sheet with Row 1 being your header row. It's dynamic so essentially plug and play. Just call on the sub with whatever code you have for entering in the other data.
Sub SerialCode()
Dim ws As Worksheet
Dim lastSerial, digits, i As Integer
Dim nextRow, lastRow As Long
Dim newSerial As String
Set ws = ThisWorkbook.Sheets(1)
nextRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1 'Finds the last row in A
lastRow = nextRow - 1
newSerial = "" 'set value of our string blank
If (nextRow - 1) < 2 Then 'If statement to catch if there's only a header
lastSerial = 0
Else: lastSerial = CInt(Replace(ws.Range("A" & lastRow).Value, "RD ", ""))
End If
lastSerial = lastSerial + 1
digits = 6 - Len(lastSerial) 'how many 0's are there
For i = 1 To digits
newSerial = newSerial & "0" 'start building the string with 0's
Next i
newSerial = "RD " & newSerial & lastSerial 'concatenate the serial code
ws.Range("A" & nextRow).Value = newSerial
End Sub
NOTE: whatever you have for finding your last row to input the other data, make sure your last row and this sub's last row are the same.