I am newbie in here in Stackoverflow and in the VBA Field. Actually I need some help with my code.
I have created a VBA(macro) and it seems there is missing with my code.
Scenario:
if column B3 has an answer(either: "FLAT" or "PER") should be applicable to all column which is same in Column A3
for example
if A3 until A500 then B3 until B500 has also an answer (either: "FLAT" or "PER").
Sub exe()
Dim number As Integer, result As String
number = Range(“a1”).Value
If number <= 1 Then
result = “Flat”
Else: result = “Per”
End If
Range(“b1”).Value = result
End Sub
Are you look for something like this:
Sub exe()
Dim LastRow As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If .Range("A" & i).Value = 0.5 Then
.Range("B" & i).Value = "FLAT"
ElseIf .Range("A" & i).Value = 2 Then
.Range("B" & i).Value = "PER"
End If
Next i
End With
End Sub
Related
Hi I'm trying to create a VBA code that fills the entire column G values with Column E - Column F (so E2-F2 = G2) but I keep getting mismatch error. The values start from the second row and I have created a loop to run down the columns.
This is the code I have so far.
Sub RemainingHours()
Dim i As Integer
i = 2
With Sheets("Opt")
While Not IsEmpty(Cells(5, i).Value)
Cells(7, i).Value = Cells(6, i).Value - Cells(5, i).Value
i = i + 1
Wend
End With
End Sub
Thank you!
Rather than looping you could try using Evaluate.
Sub RemainingHours()
Dim rng As Range
Dim Res As Variant
With Sheets("Opt")
Set rng = .Range("E2", .Range("E" & Rows.Count).End(xlUp))
End With
Res = Evaluate(rng.Offset(, 1).Address & "-" & rng.Address)
rng.Offset(, 2).Value = Res
End Sub
I have a Sheet with data and another contains filter words in the field.
My code copy data from Sheet "Data" to Sheet2 on criteria words E2:E10 in the SheetFilt. Now it works only with one criteria in E2 Cell. How can I use range E2:E10 (or Name of the range)
Sub Copy()
Dim i, LastRow
LastRow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Cells.Clear
Worksheets("Data").Rows(1).Copy Destination:=Worksheets("Sheet2").Rows(1)
For i = 2 To LastRow
If InStr(Sheets("Data").Cells(i, "H"), Sheets("SheetFilt").Range("E2")) <> 0 Then
Sheets("Data").Cells(i, "A").EntireRow.Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
End Sub
I'd like to use range E2:E10 instead of E2, something like this (but this ends with error)
If InStr(Sheets("Data").Cells(i, "H"), Sheets("SheetFilt").Range("E2:E10")) <> 0
How can I realize it ?
Try this one:
Sub Copy()
Dim i, j, LastRow as Long
LastRow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Cells.Clear
Worksheets("Data").Rows(1).Value = Worksheets("Sheet2").Rows(1).Value
For i = 2 To LastRow
For j = 2 to 10
If InStr(Sheets("Data").Cells(i, 8), Sheets("SheetFilt").Cells(j, 5)) <> 0 Then
Sheets("Sheet2").Cells(1, Rows.Count).End(xlUp).Offset(1).Value = _
Sheets("Data").Cells(i, 1).EntireRow.Value =
End If
Next j
Next i
End Sub
If there is any bug, I am just trying to follow your "idea", just let me know if something is wrong.
Hope it helps
Thanks to David. Final working variant. (Note, there is no empty cells in Filter words range E2:E50, I use any symbol instead, like "~")
Sub Copy()
Dim i, LastRow
LastRow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Cells.Clear
Worksheets("Data").Rows(1).Copy Destination:=Worksheets("Sheet2").Rows(1)
For i = 2 To LastRow
For j = 2 To 50
If InStr(Sheets("Data").Cells(i, "H"), Sheets("SheetFilt").Cells(j, "E")) <> 0 Then
Sheets("Data").Cells(i, "A").EntireRow.Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next j
Next i
End Sub
I'm creating a Macro to do almost exactly what is outlined here:
Excel/Categorization Macro(formula) based on string of text containing keywords
My question is that in the code from the example above Like "" is used to check to see if the Description matches a keyword and if it does then it pulls the corresponding category name. In my case, I don't currently have keywords for every possible category (but will eventually have them as I collect more transaction data), meaning some of the cells in my keyword column are blank and the way the above code is written it considers patternfound = true when it encounters an empty cell. How do I alter the If statement with "Like" or something similar so that it skips over a cell if it's completely blank and only provides a match when there are some characters (that match) in the cell?
I've found a work around by putting "N/A" in the empty cells but I'd rather not do that. Here is my code:
Sub Categorize()
Dim lastrow As Long, lastrow2 As Long
Dim i As Integer, j As Integer
Dim PatternFound As Boolean
Call speedup
lastrow = Sheets("Categorization").Range("B" & Rows.Count).End(xlUp).Row
lastrow2 = Sheets("Cleaned Spend Data").Range("C" & Rows.Count).End(xlUp).Row
For i = 4 To lastrow2
PatternFound = False
j = 1
Do While PatternFound = False And j < lastrow
j = j + 1
If UCase(Sheets("Cleaned Spend Data").Range("B" & i).Value) Like "*" & UCase(Sheets("Categorization").Range("B" & j).Value) & "*" Then
Sheets("Cleaned Spend Data").Range("D" & i).Value = Sheets("Categorization").Range("A" & j).Value
PatternFound = True
End If
Loop
Next i
Call normal
End Sub
Thanks!
You can test for an empty cell...
Also - your code could be cleaner using a couple of variables for your worksheets.
Sub Categorize()
Dim lastrow As Long, lastrow2 As Long
Dim i As Integer, j As Integer
Dim PatternFound As Boolean, shtCat As Worksheet, shtCleaned As Worksheet
Dim v, t
Set shtCat = Sheets("Categorization")
Set shtCleaned = Sheets("Cleaned Spend Data")
Call speedup
lastrow = shtCat.Range("B" & Rows.Count).End(xlUp).Row
lastrow2 = shtCleaned.Range("C" & Rows.Count).End(xlUp).Row
For i = 4 To lastrow2
v = UCase(UCase(shtCleaned.Range("B" & i).Value))
For j = 1 To lastrow
t = UCase(Sheets("Categorization").Range("B" & j).Value)
If Len(t) > 0 And v Like "*" & t & "*" Then
shtCleaned.Range("D" & i).Value = shtCat.Range("A" & j).Value
Exit For
End If
Next j
Next i
Call normal
End Sub
In the column AS, I have a blank column where I need to give a number to each row starting from row 3 to the last row (this is already predefined as lastrow(row number) in the VBA). Is there any way to number them from 1 to the last row in VBA programming?
For example, in the Column AS i would like to have
Row 3: 1
Row 4: 2
Row 5: 3
....
Last Row: XXX
If possible, how do you format the numbers so that they are all 4 digits
0001,
0002,
0003,
etc
MatthewD's code is fine, but my .NumberFormat method is a little cleaner, and I don't use the problematic UsedRange.
Sub M1FourDigitRow()
'
' M1FourDigitRow Macro
'
' Keyboard Shortcut: Ctrl+Shift+Q
'
Dim Range1 As Range
Dim Cell1 As Range
Set Range1 = ThisWorkbook.Sheets("Sheet9").Range(ThisWorkbook.Sheets("Sheet9").Cells(3, "AS"), ThisWorkbook.Sheets("Sheet9").Cells(1000, "AS"))
For Each Cell1 In Range1
Cell1.Value = Cell1.Row - 2
Cell1.NumberFormat = "0000"
Next Cell1
End Sub
Dim lRow As Long
Dim lCount as Long
Dim ws as excel.worksheet
Set ws = Application.ActiveSheet
Dim strCount As String
lRow = 3
lCount = 1
Do While lRow <= ws.UsedRange.Rows.count
strCount = Trim(str(lCount))
If Len(strCount) = 1 Then
ws.Range("AS" & lRow).Value = "'000" & strCount
ElseIf Len(strCount) = 2 Then
ws.Range("AS" & lRow).Value = "'00" & strCount
ElseIf Len(strCount) = 3 Then
ws.Range("AS" & lRow).Value = "'0" & strCount
Else
ws.Range("AS" & lRow).Value = "'" & strCount
End If
lCount = lCount + 1
lRow = lRow + 1
Loop
There is a much better solution that what's been offered. Excel has a Fill Series feature that can perform trends and linear progressions. It's a simple one-line function call to DataSeries() in VBA:
Range("AS3") = 1 ' Set the starting value
With Range("AS3:AS" & intLastRow)
.DataSeries xlColumns, xlLinear, , 1 ' Linear series, step = 1
.NumberFormat = "0000" ' Pad with zeros
End With
Here is a solution to give you the numbers as text and without looping:
Range("AS3:AS" & Range("B" & Rows.Count).End(xlUp).Row).formula = "=Right(""000"" & Row(AS3) - 2,4)"
Range("AS:AS").copy
Range("AS:AS").PasteSpecial xlPasteValues
Uses the ROW() function in excel then copies and pastes as values.
Assumes you have data in column B
In my worksheet some cells values are based on other cells
Info worksheet
A1: 5
B1: =A1
Design worksheet
A1:
Is there a way to copy and read the value in B1? I'm trying to use the value in a for loop, with no luck.
Sheets("Info").Select
For i = 1 to 5
If Range("B" & i).Value <> 0 Then
Range("B" & i).Copy Destination:=Sheets("Design").Range("A" & x)
'Sheets("Design").Range("A" & x).Value = Sheets("Offerte").Range("B" & i).Value
x = x + 1
End If
Next i
Your example doesn't seem to match the code well. The line
If Range("B" & i).Value = 1 Then
means that nothing will be copied in your example. It's looking for a cell with 1 in it. Why do you need that If statement at all?
EDIT I am guessing you're just checking that there's something in the cell to copy? I would probably do it this way:
If Trim(Range("B" & i).Value) <> "" Then
Also - did you miss out setting x=1?
There is more than one way to do it. One of them is using 'offset', which is a function that really worth understand. It basically points to a amount of rows / columns from the original cell.
Sub test()
Dim oCell As Excel.Range
Dim i As Integer
Dim x As Integer
Set oCell = Sheets("Info").Range("B1")
x = 1
For i = 1 To 5
If oCell.Offset(i, 0).Value = 1 Then
oCell.Offset(i, 0).Copy Destination:=Sheets("Design").Range("A" & x)
x = x + 1
End If
Next i
End Sub
Besides, you can assert the value instead of using the copy property. Notice it won't work unless x is an integer > 0.
Sub test2()
Sheets(3).Select
x = 1
For i = 1 To 5
If Range("B" & i).Value = 1 Then
Sheets(4).Range("A" & x).Value = Range("B" & i).Value
'Sheets("Design").Range("A" & x).Value = Sheets("Offerte").Range("B" & i).Value
x = x + 1
End If
Next i
End Sub