I am trying to create a VBA project like this, but I'm having a hard time using the LIKE function and nothing seems to happen when I hit the run button.
What I'm trying to do:
If the first digit is either a number or a blank cell in B4:B245, then enter a text in range D4:245.
If the last digit of the numeric is even in C4:C245, then enter a text in range D4:D245.
More info:
Product codes were imported
LEFT function was used to find the "First digit of product code"
RIGHT function was used to find the "Numeric digits of product code"
My current position in excel and VBA:
Sub number()
Dim first As Range
Set first = Range("B4:B259")
Dim numeric As Range
Set numeric = Range("C4:B259")
Dim DColumn As Range
Set DColumn = Range("D4:D259")
For Each first In DColumn
If first Like " " Then
DColumn = "Invalid Part Number"
DColumn.Interior.ColorIndex = 6
End If
Next
End Sub
The below macro will perform 3 tests & each will get it's own output.
Check for Numeric or blank first character
Check for Even ending character
Check for Odd ending character
These test are not in unison - the output will be one, or none. As soon as a test statement is TRUE, the loop will end for that cell and other values will not be tested.
For example, this macro will not provide you outputs when #1 & #2 from above are true. It will only tell you if #1 is true.
This code does not require you to split the product codes. The macro will work with them as is
Sub MyNum()
Dim xCell As Range, Product_Code As Range
Set Product_Code = Sheets("Sheet1").Range("A2:A9") '<-- Update sheet name
For Each xCell In Product_Code
If IsNumeric(Left(xCell, 1)) Or Left(xCell, 1) = " " Then
xCell.Offset(0, 1) = "Invalid Product: Char 1 = Numeric or Null"
ElseIf Right(xCell, Len(xCell) - 1) Mod 2 = 0 Then
xCell.Offset(0, 1) = "Even Ending Range"
ElseIf Right(xCell, Len(xCell) - 1) Mod 2 <> 0 Then
xCell.Offset(0, 1) = "Odd Ending Range"
End If
Next xCell
End Sub
Related
I have a VBA setup to increase the number of the cell by 1 when i click a button
Sub IncreaseCellValue()
'Add 1 to the existing cell value
Range("A1").Value = Range("A1") + 1
End Sub
This has been working fine for my invoices to save and add next number , but now i'm creating invoices that start with a letter sometimes. So for example , the cell could be 5766662 or W5766662. The above works for numbers only, so i tried the following to get it working without an error for letters/numbers , but its not working
Sub IncreaseCellValue()
Dim value As Variant
'Add 1 to the existing cell value
If IsNumeric(Range("A1").value) Then
Range("A1").value = Range("A1") + 1
Else
value = Split(Range("A1").value, " ")
Range("A1").value = value(0) & " " & (CInt(value(1)) + 1)
End If
End Sub
The above does work in the cell is W 5766662 , if a space is between the letter and number it works , but i need it to work for W5766662 or 5766662
I think it's simple if you continue to use IsNumeric and Trim to get the proper value.
Adding an error trap just in case, it would now look like:
Sub IncreaseCellValue()
Dim value As Variant
'Add 1 to the existing cell value
If IsNumeric(Range("A1").value) Then
Range("A1").value = Range("A1") + 1
Else
' Discard first character and trim spaces
value = Trim(Mid(Range("A1").value, 2)) + 1
If IsNumeric(value) Then
Range("A1").value = value
Else
MsgBox "Invalid Cell Value: " & Range("A1").value
End If
End If
End Sub
End Sub
Write formulas in VBA，this is for your reference only.
Sub IncreaseCellValue()
Range("Z1").Formula = "=TEXT(LEFT(A1),)&-LOOKUP(,-RIGHT(A1,ROW($1:$15)))+1"
[A1] = [Z1].Value: [Z1].Delete
End Sub
I've got a workbook containing a Summary sheet and 200 numbered sheets that the user fills in one after the other.
The following macro checks about 125 cell values on every numbered sheet, and fills in the Summary, one line per numbered sheet.
If a numbered sheet hasnt been used yet, the macro fills in every column from column D to column DV with the minus sign "-" and goes on to check every numbered sheet one after the other till there's no more to check.
Is there a way to set it so that if an arbitrary number (let's say 10 lines) of the newly generated lines contain only the minus sign "-" from D to DV (Iw,4 to Iw, 126), then the macro would reach its end as it means all the remaining numbered sheets aren't used yet?
Sub SummaryMacro()
Dim Sh As Worksheet
Range("B2:L1000").ClearContents
Iw = 2 ' Index Write
For Each Sh In ActiveWorkbook.Sheets
If Sh.Name = "Summary" Then GoTo EndConsolidation
Cells(Iw, 1).Select
With Selection
.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & Sh.Name & "'" & "!" & "A1", TextToDisplay:="Go to"
End With
Cells(Iw, 2) = Sh.Name
If Sh.Range("D8") = "" Then
Cells(Iw, 3) = "-"
Else
Cells(Iw, 3) = Sh.Range("D8")
End If
'Here the rest of the process (Iw, 4 till Iw, 125)
'The process also includes a few variations:
'Something like 20 of those with various text
If Sh.CheckBoxes("Check Box 1").Value = 1 Then Cells(Iw, 40) = "Declared" Else Cells(Iw, 40) = "-"
'Something like 30 of those with various text
If Sh.Range("H33") = "Issued" Then
Cells(Iw, 42) = "-"
Else
Cells(Iw, 42) = Sh.Range("H33")
End If
'But all in all they are mostly like that
If Sh.Range("C134") = "" Then
Cells(Iw, 126) = "-"
Else
Cells(Iw, 126) = Sh.Range("C134")
End If
Iw = Iw + 1
EndConsolidation:
Next Sh
End Sub
Try adding this code to your For loop at the end:
If (WorksheetFunction.CountIf(Range("D" & Iw & ":DV" & Iw), "-") = 123) Then
Cntr = Cntr + 1 'Blank sheet found
Else
Cntr = 0 'Not blank - Restart counter
End If
If (Cntr = 10) Then Exit For
This counts the number of - in your row and if it equals 123 (D-DV) then it increments the counter otherwise it clears the counter. When Cntr reaches 10 it exits the loop.
HTH
Add this code before your For loop ends
Dim counter As Integer
Dim previousRowBlank As Boolean
counter = 0
previousRowBlank = True
'count if all the 123 cells contain - string
If (WorksheetFunction.CountIf(Sheets("Summary").Range("D" & Iw & ":DV" & Iw), "-") = 123) Then
If (counter = 0) Then
counter = counter + 1
previousRowBlank = True
Else
If (previousRowBlank = True) Then
counter = counter + 1
End If
End If
Else
previousRowBlank = False
counter = 0
End If
'assuming you want to exit when 10 consecutive rows are blank
If (counter = 10) Then
Exit Sub
End If
When I have something like this I Dim a Boolean variable (perhaps call it isPopulated) which only gets switched to true when one of the cells has a value to act on. Then for your case after 10 (or however many you choose) lines, insert an If isPopulated = False Then Exit For to skip the remaining sheets.
EDIT; another idea I just had for you - if all the cells you're checking are supposed to have numeric values then you could use the below;
If Not WorksheetFunction.Concat(Range("D8"), Range("C134"), etc) Like "*#*" Then
'Code here to skip this and remaining sheets.
Obviously you'd need to add the relevant ranges inside the concat() brackets. What that will do is join the contents of those cells together, then check the result for any numbers "*#*" (you could also check for any letters using "*?*"). That gives you a one-code-line answer to the basic question 'is this sheet populated or not'.
I'm sure it's a bad idea to terminate the macro prematurely, based on such an imprecise criterion as the number of "empty" sheets in series. If data starts again on the 11th, 15th or 30th sheet, then you will not process it, you will lose it.
Your macro is not very complex, it shouldn't take longer than a few seconds. For modern Excel, 25K cells are very few
Your code can be shortened a little, simplified. After all, you know all the addresses of the cells that you need to check on each sheet, you enter them in the macro code sequentially, right? Write them on one line separated by commas and put them in a constant.
After that, the whole code will become much shorter:
Sub SummaryMacro()
Const REQUIRED_CELLS_ADDRESS As String = "D8,...<all other source cells>...,B6"
Const SUM_SHEETNAME As String = "Summary"
Dim ws As Worksheet
Dim wsSum As Worksheet
Dim rCell As Range
Dim oTargetCell As Range
Dim oSumCell As Range
Dim aAddress As Variant
Dim i As Integer
aAddress = Split(REQUIRED_CELLS_ADDRESS, ",")
Set wsSum = ActiveWorkbook.Worksheets(SUM_SHEETNAME)
wsSum.UsedRange.Offset(1, 0).ClearContents
Set oTargetCell = wsSum.Range("A1")
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> SUM_SHEETNAME Then
Set oTargetCell = oTargetCell.Offset(1, 0)
wsSum.Hyperlinks.Add Anchor:=oTargetCell, Address:="", SubAddress:="'" & ws.Name & "'" & "!" & "A1", TextToDisplay:="Go to"
oTargetCell.Resize(1, 123).Value = "-"
Set oSumCell = oTargetCell.Offset(0, 1)
oSumCell.Value = ws.Name
For i = LBound(aAddress) To UBound(aAddress)
Set rCell = ws.Range(aAddress(i))
Set oSumCell = oSumCell.Offset(0, 1)
If Not IsEmpty(rCell) Then oSumCell.Value2 = rCell.Value2
Next i
End If
Next ws
End Sub
Update Everyone knows that working with an array in RAM is much faster than working with sheet cells. Therefore, the outer loop - iterating over the sheets of the book - remains the same, but we change the code inside the loop in this way:
Sub SummaryMacro()
Const SUM_SHEETNAME As String = "Summary"
Dim ws As Worksheet
Dim wsSum As Worksheet
Dim oTargetCell As Range
Dim aResData As Variant
aAddress = Split(REQUIRED_CELLS_ADDRESS, ",")
Set wsSum = ActiveWorkbook.Worksheets(SUM_SHEETNAME)
wsSum.UsedRange.Offset(1, 0).ClearContents
Set oTargetCell = wsSum.Range("A1")
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> SUM_SHEETNAME Then
Set oTargetCell = oTargetCell.Offset(1, 0)
wsSum.Hyperlinks.Add Anchor:=oTargetCell, Address:="", SubAddress:="'" & ws.Name & "'" & "!" & "A1", TextToDisplay:="Go to " & ws.Name
aResData = validateData(ws.Range("A1:L140").Value2) ' Or "D8:C134" or any other
oTargetCell.Offset(0, 1).Resize(1, UBound(aResData) + 1).Value = aResData
End If
Next ws
End Sub
The main trick is hidden in this line aResData = validateData(ws.Range("A1:L140").Value2)
We call our function and pass it as a parameter an array of cell values from the entire next sheet. Further work on analysis and processing will be carried out with the elements of this array. However, this is not the whole trick.
The validateData() function is very simple and looks like this:
Function validateData(aD As Variant) As Variant
validateData = validateValues(aD(1, 5), aD(2, 8), aD(3, 1), aD(2, 11), _
........ , _
aD(111, 3), aD(112, 8), aD(123, 9), aD(126, 10))
End Function
In other words, we select from the entire large array of aD (the name is deliberately made short, because in this function it will have to be repeated 123 times) only those values that need to be analyzed and we pass on to the next function. Despite the seeming simplicity, this is the most time-consuming part - you need to select from the sheet all cells "D8", "C134", etc. and write down their coordinates (row, column) as numbers aD(4,8), aD(3,134), etc.
Perhaps can help in this the mode R1C1 of displaying the sheet. Or some kind of helper function that will be used when preparing the code (not when executing - we agreed that we will no longer access cells for get values or for .Row and .Column properties!)
What will the validateData() function get? A long one-dimensional array aData(0 To 122) of cell values in the listed order. That is, as many values as there are cells to be filled in the Summary row for this sheet.
The last trick is the process of processing values. It would seem that we have gained nothing from all these transformations. But you claim that there are three groups of checks - for an empty value, for a boolean value (checkbox) and for text lines. This is how it is handled:
Function validateValues(ParamArray aData() As Variant) As Variant
Dim i As Variant
Dim aResult As Variant
ReDim aResult(LBound(aData) To UBound(aData))
For i = LBound(aData) To UBound(aData)
Select Case i
Case 1, 5, 7, 9 ' Checking cells empty / value
aResult(i) = IIf(aData(i) = "", "-", aData(i))
Case 4, 6, 10 ' Checking cells boolean True / "not True" (False or blank)
aResult(i) = IIf(aData(i), "Declared", "-")
Case 0, 3, 8 ' Checking cells string "Issued" / other
aResult(i) = IIf(aData(i) = "Issued", "-", aData(i))
Case 2, 91, 118 ' Checking cells string "Pending" / other
aResult(i) = IIf(aData(i) = "Issued", "-", aData(i))
Case Else ' In a real macro, this line is not needed, it will never be executed because all the cells of the array are already listed above, this is useful only for debugging while all conditions will be written
aResult(i) = "-"
Debug.Print "Cell #" & i & " not processed yet"
End Select
Next i
validateValues = aResult
End Function
And now - again, in just one call! - we write a whole row of results:
oTargetCell.Offset(0, 1).Resize(1, UBound(aResData) + 1).Value = aResData
I am sure that these tricks will reduce the time it takes to form the summary sheet many times over. Please try this and let me know if it gets better?
I am writing a VBA code to go through a specified range or ranges, look for a keyword provided by the user at run-time, and grab the value in the cell offset from the cell with the keyword by an amount also provided by the user. For instance, if you wanted to look through A1:B10 for the word "Apple" and then grab the value in the cell to the right of every instance of "Apple", it can do that. Two weird things have been occurring for me. First and not so weird, when I run it and click the cancel button on the userform that only contains the single line "Unload Me", it throws an error saying it expected and End Sub statement, but it has one. I don't know why it is doing that. Weird thing number 2. Whenever I click and move the cursor to the end of the file after the Cancel_Click() sub, my excel crashes and closes. Every. Single. Time. And it is weird that it does that just from me clicking. It also sometimes happens when I click around the Cancel_Click() sub or hit enter around there too. Just simply from clicking. I don't get it. Any ideas? Code contained in the userform is below. Fyi, the user can input ranges like "A1:A10,E1:E10" separated by commas for multiple ranges. I don't think it is important for this question, but I thought I would add that since i don't know how to add the userform here, if you even can.
Private Sub Accept_Click()
'Searches for string input into the KeywordBox
'Grabs contents of the cell defined by the OffsetBox
'The range it searches through is defined by the RangeBox
Dim rawRange As String: rawRange = Me.RangeBox.Text
Dim rawOffset As String: rawOffset = Me.OffsetBox.Text
Dim Keyword As String: Keyword = Me.KeywordBox.Text
Dim numOfRanges As Integer: numOfRanges = 1
Dim Ranges() As Range
Dim commaLoc As Integer: commaLoc = -1
Dim tempRange As String: tempRange = rawRange
Dim offset As Integer
Dim values() As Double
Dim valCount As Integer: valCount = 0
'--------------------------------------------------------
'Set ranges
For i = 1 To Len(rawRange)
If (Mid(rawRange, i, 1) = ",") Then
numOfRanges = numOfRanges + 1
End If
Next
ReDim Ranges(numOfRanges) As Range
If (Not numOfRanges = 1) Then
For i = 1 To numOfRanges - 1
commaLoc = InStr(1, tempRange, ",")
Set Ranges(i) = Range(Left(tempRange, commaLoc - 1))
tempRange = Right(tempRange, Len(tempRange) - commaLoc)
Next
End If
Set Ranges(numOfRanges) = Range(tempRange)
'---------------------------------------------------------
'Set offset
If (IsNumeric(rawOffset)) Then
offset = CInt(rawOffset)
Else:
MsgBox ("Offset was not input as a number")
Exit Sub
End If
'----------------------------------------------------------
'Searches for keyword
For i = 1 To numOfRanges
For Each cell In Ranges(i)
If (cell.Value = Keyword) Then
valCount = valCount + 1
End If
Next
Next
ReDim values(valCount) As Double
valCount = 0
For i = 1 To numOfRanges
For Each cell In Ranges(i)
If (cell.Value = Keyword) Then
valCount = valCount + 1
values(valCount) = cell.offset(0, offset).Value
End If
Next
Next
For i = 1 To valCount
Range("I" & i).Value = values(i)
Next
Unload Me
End Sub
I've had similar, weird things happen to me. A good thing to try is to force the VBA project to reset, then save, exit, and restart Excel.
To force a project reset, add an Enum to the general section of one of your code modules. It doesn't matter what the enum is...make it something simple, like
Enum stoplight
Red
Yellow
Green
End Enum
As you do that, you'll get a message saying that it will reset your project. That's fine; let that happen. Then save your Excel workbook, exit excel completely, start it up again, reload your workbook, go into the VBA Editor, and delete the enum you added. Then recompile and see if things work better for you.
You put an "Exit Sub" in the set offset, this is probably causing your problem.
I was able to fix the issue by making a new workbook and copying everything over. It worked fine. I think the original was corrupted somehow. For those having the same issue, I think Rich Holton's answer would be worth a try in case you have more than just a few things to copy. Thanks everyone for you time and input on this!
I'm working on problem that necessitates the use of nested formulas in excel. For eg:
I have a column for errors and one for its analysis
Error Analysis
Enter a valid material number Invalid Material
Eg errors:
Enter a valid material number; The material number 1234 does not
exist.
PO number XYZ does not exist.
VIN number 123 does not exist.
Country of origin AB does not exist.
I have a compendium of such errors and their analyis in the next sheet, and I'm using VLOOKUP in conjuction with FIND to lookup the analysis for the known errors.
=VLOOKUP(LEFT(F2, FIND(" ", F2, FIND(" ", F2) + 1) - 1)&"*", 'Sheet2'!A:B, 2, 0)
What i'm trying to do here is extract the first two words from the error and append a * to it and use it in VLOOKUP.
It would be something like Vlookup "PO number *" in the other sheet and get the analysis for it. Asterisk is because I don 't get the same number daily. And I also know that the extracted first two words of the error will be unique. (I know that error with "Enter a" as the first two words will not appear again).
Now I get errors in the same column so I thought of making a button and writing a code which uses the above formula.
I tried to modify some code off the net, but I'm not getting anywhere with it. I'm totally new to VBA. It'd be great if you can provide a snippet for this. I'll try to replicate the procedure for other needs.
This code seems to be working for now
Sub PopulateAnalysis()
Dim an_row As Long
Dim an_clm As Long
Dim lft As String
Dim st_num As Integer
Dim fin As String
Dim searchStr As String
Dim soughtStr As String
Table1 = Sheet1.Range("F2:F6") 'ErrorColumn from Error table (How do I make the range dynamic??)
Table2 = Sheet5.Range("A1:B6")
an_row = Sheet1.Range("G2").Row ' Populate this column from the analysis table on sheet2
an_clm = Sheet1.Range("G2").Column
For Each cl In Table1
'How do I translate the above formula into VBA statements??
st_num = InStr(InStr(cl, " ") + 1, cl, " ")
lft = left(cl, st_num - 1)
fin = lft & "*"
Sheet1.Cells(an_row, an_clm) = Application.WorksheetFunction.VLookup(fin, Table2, 2, True)
an_row = an_row + 1
Next cl
MsgBox "Done"
End Sub
This should work. You don't need the debug lines of course ;)
Sub PopulateAnalysis()
Dim rngTableWithErrors As Range
Dim rngTableWithAnalysis As Range
Application.ScreenUpdating = False
'set the range for Table with error, Table1 on sheet 1
With Sheets(1) 'change to name of the sheet, more reliable than index num.
Set rngTableWithErrors = .Range("F2:F" & .Cells(.Rows.Count, 6).End(xlUp).Row)
Debug.Print rngTableWithErrors.Address
End With
'set the range for Table with Analysis, Table 2 on sheet 2
With Sheets(2) 'change to name of the sheet, more reliable than index num.
Set rngTableWithAnalysis = .Range("A1:B" & .Cells(.Rows.Count, 2).End(xlUp).Row)
Debug.Print rngTableWithAnalysis.Address
End With
'formula for cell G2
'=VLOOKUP(LEFT(F2;FIND(" ";F2;FIND(" ";F2)+1)- 1)&"*";Sheet2!A1:B23;2; 0)
rngTableWithErrors.Offset(0, 1).FormulaR1C1 = _
"=VLOOKUP(LEFT(R[0]C[-1],FIND("" "",R[0]C[-1],FIND("" "",R[0]C[-1])+1)-1)& ""*"",Sheet2!R1C1:R" & rngTableWithAnalysis.Rows.Count & "C2,2, 0)"
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
Notes
You can notice, that we are setting the upper left cells of ranges manually. It's better practice to somehow find the upper left cells (using Find method is my favorite) and work from there. You never know, how the user will change the worksheet - i.e. add new rows, columns etc.
I have a problem. I spent hours designing a form which works just great with all your feedback. Today, everything went wrong. The reason for this is simple. A few new columns got added and, obviously, the data my form is reading in is now wrong.
Thus I was thinking of trying the following...
Rather than using the column number as below
TK = Cells(ActiveCell.Row, "S").Value 'everything in the form refers to the active row
I could possibly use the column headings in Row 1.
Is that possible ? This way the spreadsheet can have columns added up to as many as a user would like and the form would dynamically scan for the right heading and get the column number that way.
My thought is, on opening the form, read in all the headings, pick out the ones I need and assign them to a variable. Then I use my normal code and substitute the variable into the column section.
It sounds easy, but I have no idea how to do this.
Use the versatile Find to give you a quick method of detecting where your header is - or if it is missing
Find details here
In the code below I have specified that the search must return
an exact match (xlWhole)
a case sensitive match (False)
The match can be a partial match (xlPart) if you were looking to match say Game out of Game X
code
Const strFind = "Game"
Sub GetEm()
Dim rng1 As Range
Set rng1 = ActiveSheet.Rows(1).Find(strFind, , xlValues, xlWhole, , , False)
If Not rng1 Is Nothing Then
MsgBox "Your column is " & rng1.Column
Else
MsgBox strFind & " not found", vbCritical
End If
End Sub
Why use a loop? There's no need to.
Dim col as variant
Col = application.match("my header", rows(1), 0)
If iserror(col) then
'not found
Else
TK = cells(activecell.row, col)
End if
For this purpose I usually use a function which runs through the headers (in the first row of a sheet) and returns the number of the column which contains the value I have searched for.
Public Function FindColumn(HeaderName As String, Sht As String) As Long
Dim ColFound As Boolean
Dim StartingPoint As Range
ColFound = False
Set StartingPoint = Sheets(Sht).Range("A1")
Do While StartingPoint.Value <> ""
If UCase(Trim(StartingPoint.Value)) = UCase(Trim(HeaderName)) Then
FindColumn = StartingPoint.Column
ColFound = True
Exit Do
Else
Set StartingPoint = StartingPoint.Offset(0, 1)
End If
Loop
If Not ColFound Then FindColumn = 0
End Function
Example:
If the first row of your sheet named "Timeline" contains headers like e.g. "Date" (A1), "Time" (B1), "Value" (C1) then calling FindColumn("Time", "Timeline") returns 2, since "Time" is the second column in sheet "Timeline"
Hope this may help you a little.
Your thought is a good one. Reading in column headers to calculate addresses is one way to avoid hard coding - e.g.
Sub Test()
Dim R As Range
Set R = ActiveSheet.[A1]
Debug.Print ColNo(R, "Col1Hdr")
End Sub
Function ColNo(HdrRange As Range, ColName As String) As Integer
' 1st column with empty header is returned if string not found
ColNo = 1
Do While HdrRange(1, ColNo) <> ""
If HdrRange(1, ColNo) = ColName Then Exit Do
ColNo = ColNo + 1
Loop
End Function
Another way I frequently use - and I must admit I prefer it over the above, is to define Enum's for all my tables in a seperate "definition" module, e.g.
Public Enum T_VPN ' sheet VPN
NofHRows = 3 ' number of header rows
NofCols = 35 ' number of columns
MaxData = 203 ' last row validated
GroupNo = 1
CtyCode = 2
Country = 3
MRegion = 4
PRegion = 5
City = 6
SiteType = 7
' ....
End Enum
and use it like
Sub Test1()
Debug.Print ActiveSheet(T_VPN.NofHRows, T_VPN.Country)
End Sub
As you can see, the usage is simpler. Allthough this is again "some kind" of hardcoding, having all definition in one place reduces maintenance significantly.