I've written the following code to check if values in row A equal to "Forecast" then Range D5:D53 should have its contents cleared.
Row 1 is a vlookup so there's a formula that derives "Actual" or "Forecast"
Dim k As Integer
For k = 1 To 13
If Sheets("2017 Forecast").Cells(k, 1).Value = "Forecast" Then
Sheets("2017 Forecast").Range("D5:D53").Select.ClearContents
End If
Next k
There's no need to use Select before you use ClearContents.
Also, try adding UCase to make sure you don't have any CAPITAL letter in the middle of your text.
Code
Dim k As Integer
With ThisWorkbook.Sheets("2017 Forecast")
For k = 1 To 13
If UCase(.Cells(k, 1).Value2) = "FORECAST" Then
.Range("D5:D53").ClearContents
End If
Next k
End With
Maybe this works for you?
Option explicit
Sub Compare skies()
Dim k As long
Dim ValueRead as variant
With Sheets("2017 Forecast")
For k = 1 To 13
ValueRead = .Cells(k, 1).Value
' Slow, case insensitive string comparison '
If strcomp(ValueRead,"Forecast",vbtextcompare) = 0 Then
.Range("D5:D53").ClearContents ' You want to clear the exact same range 13 times? '
Elseif strcomp(ValueRead,"Actual",vbtextcompare) <> 0 then
Msgbox("VLOOKUP returned a value outside of Actual and Forecast")
End if
Next k
End with
End sub
Related
I have non-microsoft files that have look along the lines of:
>gibberish that changes
AAARRGGGHHHH
Now, I have a code to make a new .xlsx file out of this to split using Trying to convert files while keeping the old name.
However, I would like the "A2" cell contents to split with each indivual letter being assigned a cell and then have the former contents deleted. I don't mind if this ends up in A3 till AZ.
Thus, the above example I would like to transform to make it look like:
>gibberish that changes
A A A R R G G G H H H H
To clarify "Gibberish that changes" is not a constant it changes per file I have what is denoted here. Same holds true for the second line.
Based on Split cell string into individual cells
I tried this code:
Dim sVar1 as string
Dim sVar2 as string
I = InStr(1, strX, "A" & "R" & "G" & "H")
sVar1 = mid(strX, 1, I)
sVar2 = mid(strx,i+1)
However, this yields no results. It does not cause the Macro to fail (as I get no error message and the rest of the macro works (changing a file into another format and altering the name), but it doesn't do anything. I would like to use the string as the files constantly change in contents and order in cell A2.
I also have no true delimiter as things like ARRGHHHH is written as one word, is that causing the issue?
my 0.02 with Character object
Sub main()
With Range("A2")
For i = 1 To Len(.Value)
.Offset(, i) = .Characters(i, 1).Text
Next i
End With
End Sub
This will parse A2 into its characters and place the characters next to A2, each in its own cell:
Sub dural()
With Range("A2")
v = .Value
L = Len(v)
For i = 1 To L
.Offset(0, i).Value = Mid(v, i, 1)
Next i
End With
End Sub
EDIT#1:
This will handle both a range of input cells and the clearing of the original input data. Before:
The new macro:
Sub dural2()
Dim rng As Range, r As Range, v As Variant
Dim L As Long, i As Long
Set rng = Range("A2:A40")
For Each r In rng
v = r.Value
L = Len(v)
For i = 1 To L
r.Offset(0, i - 1).Value = Mid(v, i, 1)
Next i
Next r
End Sub
The result:
Would this be helpful at all?
Sub Test()
Dim i As Integer
Dim num As Integer
num = Len(Range("A1"))
For i = 1 To num
Debug.Print Mid(Range("A1"), i, 1)
Next
End Sub
Try this.
Sub dural()
With Range("A2")
v = .Value
L = Len(v)
For i = 0 To L - 1
If i = 0 Then
.Offset(0, i).Value = Left(v, 1)
Else
.Offset(0, i).Value = Mid(v, i, 1)
End If
Next i
End With
End Sub
Input
output
What I am trying to achieve:
I want to fully automate the process of cleaning up exported data.
I want to move the data in the overflow rows into their prospective column. I have tried the following code in VBA. (This is trying to identify the # symbol in the emails and respectively move all email address two places to the right).
Sub qwerty()
Dim D As Range, r As Range
Set D = Intersect(ActiveSheet.UsedRange, Range("D:D"))
For Each r In D
If Left(r.Text, 2) = "#" Then
r.Copy r.Offset(0, 1)
r.Clear
End If
Next r
End Sub
Once the data is in the correct column I need to automate the movement into the correct row. I can easily have them shift up but if one contact doesn't have an email address (as an example) then the emails will be in the wrong rows when they shift up.
Something like this should work:
Sub Tester()
Dim rw As Range, currRow As Long
Dim v, col As Long
Set rw = ActiveSheet.Rows(2)
currRow = 0
Do While rw.Row <= ActiveSheet.UsedRange.Rows.Count
If rw.Cells(2).Value <> "" Then
currRow = rw.Row 'moving "overflow" items to this row...
Else
If currRow > 0 Then
v = rw.Cells(4).Value
col = 0
'Figure out which column item should be moved to...
' "[" is a special character to "Like", so needs to be
' enclosed in "[]"
If v Like "[[]M]:*" Then
col = 8
ElseIf v Like "[[]E]:*" Then
col = 6
ElseIf v Like "[[]H]:*" Then
col = 7
ElseIf v Like "[[]Address]:*" Then
col = 9
End If
'Got a pattern match, so move this item...
'Change ".Copy" to ".Cut" when you're done testing...
If col > 0 Then rw.Cells(4).Copy ActiveSheet.Cells(currRow, col)
End If
End If
Set rw = rw.Offset(1, 0) 'next row....
Loop
End Sub
Basically I am trying to go through cells that have a value of less than 50 in a column(R:R)
Here is the code:
Sub Macro1()
'
' Macro1 Macro
'
'
Sheets("Pyxis Inventory 6North1 and 6No").Select
Cells(1).EntireRow.Copy (Sheets("Sheet1").Range("A1").EntireRow)
Cells(1).EntireRow.Copy (Sheets("Sheet2").Range("A1").EntireRow)
Dim val1, val2 As String
Dim i, j, x As Integer
Dim colCount As Integer
Dim daysUnused As Boolean
Dim daysVal As Integer
colCount = Sheets("Pyxis Inventory 6North1 and 6No").Range("A1").CurrentRegion.Rows.Count
daysUnused = IsEmpty(Sheets("Settings").Range("B2"))
If daysUnused = True Then
'do nothing yet
ElseIf daysUnused = False Then
daysVal = Sheets("Settings").Range("B2").Value
For x = 2 To colCount
If Cells(x, 18).Value <= daysVal Then
Cells(x, 18).EntireRow.Copy (Sheets("Sheet4").Range("A1").Offset(x, 0))
Cells(x, 18).EntireRow.Delete
End If
Next x
End If
End Sub
My problem is that it doesn't delete rows with numbers less than 50.
I have formatted the cells in the column 18 to be of number only as well.
What i want to do is basically sort, but instead of keeping the values I want to delete anything that is less than 50 or whatever the user enters for daysVal variable.
Thank you
To start with it, it is best practise when deleting rows to start at the bottom and work up. e.g. For x = colCount to 2 step -1.
The If daysUnused = True and ElseIf daysUnused = False Then are over-evaluating a simple boolean. The latter could be shortened to Else. By strict definition, if you are not going to do anything when True, a Not should be more than enough.
daysUnused = IsEmpty(Sheets("Settings").Range("B2"))
If Not daysUnused Then
daysVal = Sheets("Settings").Range("B2").Value
For x = colCount to 2 step -1
If Cells(x, 18).Value <= daysVal Then
Cells(x, 18).EntireRow.Copy Sheets("Sheet4").Range("A1").Offset(x, 0)
Cells(x, 18).EntireRow.Delete
End If
Next x
End If
It sounds like you fell into the row-skipping trap that makes bottom-to-top (and right-to-left when deleting columns) a canonical practise. Hopefully the above will help you tighten up your code.
I have an Excel Worksheet consisting of two columns, one of which is filled with strings and the other is emtpy. I would like to use VBA to assign the value of the cells in the empty column based on the value of the adjacent string in the other column.
I have the following code:
Dim regexAdmin As Object
Set regexAdmin = CreateObject("VBScript.RegExp")
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin"
Dim i As Integer
For i = 1 To 10 'let's say there is 10 rows
Dim j As Integer
For j = 1 To 2
If regexAdmin.test(Cells(i, j).Value) Then
Cells(i, j + 1).Value = "Exploitation"
End If
Next j
Next i
The problem is that when using this loop for a big amount of data, it takes way too long to work and, most of the time, it simply crashes Excel.
Anyone knows a better way to this?
You have an unnecessary loop, where you test the just completed column (j) too. Dropping that should improve the speed by 10-50%
Dim regexAdmin As Object
Set regexAdmin = CreateObject("VBScript.RegExp")
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin"
Dim i As Integer
For i = 1 To 10 'let's say there is 10 rows
If regexAdmin.test(Cells(i, 1).Value) Then
Cells(i, 1).offset(0,1).Value = "Exploitation"
End If
Next i
If the regex pattern really is simply "Admin", then you could also just use a worksheet formula for this, instead of writing a macro. The formula, which you'd place next to the text column (assuming your string/num col is A) would be:
=IF(NOT(ISERR(FIND("Admin",A1))),"Exploitation","")
In general, if it can be done with a formula, then you'd be better off doing it so. it's easier to maintain.
Try this:
Public Sub ProcessUsers()
Dim regexAdmin As Object
Set regexAdmin = CreateObject("VBScript.RegExp")
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin"
Dim r As Range, N As Integer, i As Integer
Set r = Range("A1") '1st row is headers
N = CountRows(r) - 1 'Count data rows
Dim inputs() As Variant, outputs() As Variant
inputs = r.Offset(1, 0).Resize(N, 1) ' Get all rows and 1 columns
ReDim outputs(1 To N, 1 To 1)
For i = 1 To N
If regexAdmin.test(inputs(i, 1)) Then
outputs(i, 1) = "Exploitation"
End If
Next i
'Output values
r.Offset(1, 1).Resize(N, 1).Value = outputs
End Sub
Public Function CountRows(ByRef r As Range) As Long
If IsEmpty(r) Then
CountRows = 0
ElseIf IsEmpty(r.Offset(1, 0)) Then
CountRows = 1
Else
CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
End If
End Function
when we are going to do a loop in the rows, we can use code like the following:
i = 1
Do
Range("E" & i & ":D" & i).Select
i = i + 1
Loop Until i > 10
but what if we want to do a loop on a column?
Can we use the same method as above?
while the columns in Excel is a complex such as A, B, C, ..., Y, Z, AA, AB, AC, ..., etc.
problems will arise between loop from the "Z" to the "AA".
how we do looping alphabet column from "A" to "Z" and then continued into "AA", "AB" and so on
is there anything that can help?
Yes, let's use Select as an example
sample code: Columns("A").select
How to loop through Columns:
Method 1: (You can use index to replace the Excel Address)
For i = 1 to 100
Columns(i).Select
next i
Method 2: (Using the address)
For i = 1 To 100
Columns(Columns(i).Address).Select
Next i
EDIT:
Strip the Column for OP
columnString = Replace(Split(Columns(27).Address, ":")(0), "$", "")
e.g. you want to get the 27th Column --> AA, you can get it this way
Another method to try out.
Also select could be replaced when you set the initial column into a Range object. Performance wise it helps.
Dim rng as Range
Set rng = WorkSheets(1).Range("A1") '-- you may change the sheet name according to yours.
'-- here is your loop
i = 1
Do
'-- do something: e.g. show the address of the column that you are currently in
Msgbox rng.offset(0,i).Address
i = i + 1
Loop Until i > 10
** Two methods to get the column name using column number**
Split()
code
colName = Split(Range.Offset(0,i).Address, "$")(1)
String manipulation:
code
Function myColName(colNum as Long) as String
myColName = Left(Range(0, colNum).Address(False, False), _
1 - (colNum > 10))
End Function
If you want to stick with the same sort of loop then this will work:
Option Explicit
Sub selectColumns()
Dim topSelection As Integer
Dim endSelection As Integer
topSelection = 2
endSelection = 10
Dim columnSelected As Integer
columnSelected = 1
Do
With Excel.ThisWorkbook.ActiveSheet
.Range(.Cells(columnSelected, columnSelected), .Cells(endSelection, columnSelected)).Select
End With
columnSelected = columnSelected + 1
Loop Until columnSelected > 10
End Sub
EDIT
If in reality you just want to loop through every cell in an area of the spreadsheet then use something like this:
Sub loopThroughCells()
'=============
'this is the starting point
Dim rwMin As Integer
Dim colMin As Integer
rwMin = 2
colMin = 2
'=============
'=============
'this is the ending point
Dim rwMax As Integer
Dim colMax As Integer
rwMax = 10
colMax = 5
'=============
'=============
'iterator
Dim rwIndex As Integer
Dim colIndex As Integer
'=============
For rwIndex = rwMin To rwMax
For colIndex = colMin To colMax
Cells(rwIndex, colIndex).Select
Next colIndex
Next rwIndex
End Sub
Just use the Cells function and loop thru columns.
Cells(Row,Column)