In excel I have a column of words which I need to convert to integers. For example, I have a column of industries:
Capital Goods,
List item,
Consumer Services,
Technology, etc.
I want to replace each of these industries with an integer.
Below, something I was trying in VBA but which didn't work. Here I am trying to loop through the column and if the word in the current cell is different from the word in the previous cell then I assign it a different integer. (But it's not working)
Sub WordtoNum()
Dim ws As Worksheet
Dim varList
Dim rng1 As Range
Dim lngCnt As Long
Dim startrow, wsheet, tt As Integer
' Enter the worksheet and starting row
'---------------------------------------
wsheet = 2
startrow = 2
'---------------------------------------
Set ws = Sheets(wsheet)
Set rng1 = ws.Range(ws.[a1], ws.Cells(Rows.Count, "A").End(xlUp))
varList = rng1.Value2
tt = 0
For lngCnt = startrow To UBound(varList)
If varList(lngCnt, 2) <> varList(lngCnt - 1, 2) Then _
tt = tt + 1
varList2(lngCnt, 2) = tt
Next
rng1.Value2 = varList
End Sub
This code is largely based on help I received in a recent, related post.
Why not use the build in Excel function, VLOOKUP? It looks up a word in a sorted column and returns a value from another column, but the same row as the match. Read more on Office Help about VLOOKUP
I realise the question you asked was how to do this in VBA, however, I'm not sure if you really wanted to use VBA as an exercise or just didn't know about this function?
Related
First of all I would like to introduce myself. Iam Miguel and I recently started to learn VBA in order to improve and save time at work. I am familiar with formulas, all types, but when turning to VBA I get sometimes stuck.
I am trying to loop the range A2:A355 from Sheet"Aux" and copy each value to sheet "CS", and each value shall be pasted in Column A:A, but with the offset given in range B2:B355 Sheet "Aux". For Example I give the example attached.
Sample Code:
This is the code:
Sub cablexsection()
Dim s As Integer
Dim smax As Integer
smax = Sheets("Aux").Range("b1").Value
Sheets("CS").Activate
For s = 3 To smax
Sheets("CS").Cells(s, 1).Value = Sheets("Aux").Cells(s, 1).Value
'here I have to set the offset to down in order to paste cells given Sheets("Aux").Cells(s, 2) values
Next s
End Sub
And under the link you can find the file to be worked in:
Original File
Thank you very much and sorry if this question is repeated. I have tried to look through the forum but maybe I do not know what to write exactly.
Try this
Option Explicit
Sub CableXsection()
Dim wsAux As Worksheet, wsCS As Worksheet
Dim s As Long, sMax As Long, offSetCell As Range
Set wsAux = ThisWorkbook.Worksheets("Aux")
Set wsCS = ThisWorkbook.Worksheets("CS")
sMax = wsAux.Range("B1").Value
Application.ScreenUpdating = False
For s = 3 To sMax
Set offSetCell = wsAux.Cells(s, 2) '2 is the offset column from the same row
If Not IsError(offSetCell) And IsNumeric(offSetCell) Then
wsCS.Cells(offSetCell.Value2 + s, 1).Value = wsAux.Cells(s, 1).Value
End If
Next
Application.ScreenUpdating = True
End Sub
I don't know if this is possible or if I'm just searching wrong keywords.
Basically I have user-form with multi-page arrangement and I wondered if it possible for one of multi-pages to display running tally of what on the worksheet.
Example:on spreadsheet (Data) column B description of asset: Laptop, Desktop, Printer etc. and then User-form looks at sheet (Data) and then display to end user on user-form running tally of Laptops = 7 Desktop = 9 Printers = 2.
Depending on how many words are in that column matching the word looking for.
I don't know where to start to create code to do is and I can't seem to find any help on any websites when searching Google (VBA User-form to display column count).
Sorry If I'm not asking in correct way on here just at complete loss with what to do.
Thank you in advance.
You can create a function to do this.
Assign all the cells in your column into a string, then push that string into your function.
Function countWords(ByVal sText As String) As Long
Dim sTextArr() As String
sTextArr = Split(sText, " ")
countWords = UBound(sTextArr) + 1
End Function
Sub test()
Dim myStr As String
myStr = "The dog barked non-stop. I wish he would stop"
MsgBox countWords(myStr)
End Sub
You would just assign the value of countWords to your userform control.
If you want to add the values into a ListBox with two columns on your UserForm, having the item in the first column and the count of items in the second column then the following will help:
Sub foo()
Dim k As Variant
Dim d As Variant
Dim c As Range
Dim rng As Range
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
'get the last row with data on Column B
Set rng = ws.Range("B2:B" & LastRow)
Set d = CreateObject("Scripting.Dictionary")
For Each c In rng
d(c.Value) = d(c.Value) + 1
Next c
For Each k In d
If k <> "" Then
ListBox1.AddItem k
ListBox1.List(ListBox1.ListCount - 1, 1) = d(k)
End If
Next k
End Sub
I don't know how to best describe this but it's better that I explain my problem in pictures.
I have 2 worksheets:
In worksheet Array, there are certain periods with their corresponding 'Array' associated with them.
In Sheet1, there is a list of strings in the format: dd/mm/yyyy hh:mm:ss AM/PM - # ordered by ascending order of number, then by date and finally by time.
The code I have, generates those values in Sheet1 by extracting the data in Array and listing them out in one cell. The code I've used is.
Sub Filter()
Const Array_FirstRow As Integer = 2 'Indicates the first row (row 2) in Array sheet
Dim Array_RowIndex As Integer 'variable to loop through array values of col A
Dim Summary_PeriodMoment1 As String 'in worksheet Sheet 1
Array_RowIndex = Array_FirstRow
Array_LastRow = Array_RowIndex - 1
Summary_PeriodMoment1 = ""
For Array_RowIndex = Array_FirstRow To Array_LastRow
If Summary_PeriodMoment1 <> " " Then
Summary_PeriodMoment1 = Summary_PeriodMoment1 & ", " & Worksheets("Array").Cells(Array_RowIndex, Array_DateTime_Column).Value
End If
Next
Sheet1.Cells(1, 1).Value = Summary_PeriodMoment1
End Sub
This is slightly confusing and overly complicated to read. Is there any way to add code to :
Sort/group the values by # and consolidate by date (to make it less confusing)? Like so?
Have a separate cell for each value, again categorized by # (I would like to plot these values on a pivot graph later on using other code, so would like it to be in a friendly format
Essentially I would like to do some data reformatting/transposing with a VBA script. Any idea what functions I should use? thanks!
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Update: I have what I need for transposing a string of values in one cell. I wonder if this can be done for multiple cells. I tried using this code:
Sub TextToRows()
'Code for 1.2. section
Dim Arr As Variant
Dim Arr1 As Variant
Dim Arr2 As Variant
Dim InputRng As Range, InputRng2 As Range, InputRng3 As Range, OutputRng As Range, OutputRng1 As Range, OutputRng2 As Range
Set InputRng = Range("B1") 'Cell Containing all the text
Set InputRng1 = Range("B2")
Set InputRng2 = Range("B3")
Set OutputRng = Range("D1") 'First Cell of a column that you want the output there
Set OutputRng1 = Range("G1")
Set OutputRng2 = Range("J1")
Arr = Split(InputRng.Value, ",")
Arr1 = Split(InputRng.Value, ",")
Arr2 = Split(InputRng.Value, ",")
Set OutputRng = OutputRng.Resize(UBound(Arr) - LBound(Arr) + 1)
OutputRng.Value = Application.Transpose(Arr)
Set OutputRng1 = OutputRng1.Resize(UBound(Arr1) - LBound(Arr1) + 1)
OutputRng.Value = Application.Transpose(Arr1)
Set OutputRng2 = OutputRng2.Resize(UBound(Arr2) - LBound(Arr2) + 1)
OutputRng.Value = Application.Transpose(Arr2)
End Sub
Seems it only works for InputRng and not InputRng1 or InputRng2
1.
How to split comma-delimited data in one cell? (Look below)
1.1. If you don't have any other data, and number of records are not more than number of possible columns in excel then transposing within the worksheet is an option (Instead of using the code below).
1.2. (If you have more data than limit of excel columns): Otherwise, you need to use arrays. The code below answers first part of your question. It will split the cell for "," as delimiter.
2.
Then you can use Text to Columns in Data tab and delimiter ":" to get the numbers in one column and dates in another one.
3.
Use How To Transpose Cells In One Column Based On Unique Values In Another Column? to group them based on the numbers.
Sub TextToRows()
'Code for 1.2. section
Dim Arr As Variant
Dim InputRng As Range, OutputRng As Range
Set InputRng = Range("B1") 'Cell Containing all the text
Set OutputRng = Range("D1") 'First Cell of a column that you want the output there
Arr = Split(InputRng.Value, ",")
Set OutputRng = OutputRng.Resize(UBound(Arr) - LBound(Arr) + 1)
OutputRng.Value = Application.Transpose(Arr)
End Sub
Just started a new job. I'm automating a month-end report and I'm new at VBA. Been googling most of my issues with success, but I've finally run into a wall. In essence I'm downloading some data from SAP and from there I need to build a report.
My question is: How to do a sumif function using loops in VBA?
Data pull:
Sheet1 contains a product code and purchase amounts (columns A & B) respectively. One product code can have several purchases (several rows with the same product code).
Steps so far:
I arranged the data sheet1 to be in ascending order.
Copied unique values for the product codes onto another sheet (sheet2). So Sheet2 has a list of all the products (in ascending order).
I want to get the sum of all purchases in sheet2 column B (per product code). I know how to do this using formulas, but I need to automate this as much as possible. (+ I'm genuinely interested in figuring this out)
This is what I did in VBA so far:
Sub Macro_test()
Dim tb As Worksheet
Dim tb2 As Worksheet
Dim x As Integer
Dim y As Integer
Dim lrow As Long
Set tb = Sheets("sheet1")
Set tb2 = Sheets("sheet2")
lrow = tb.Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To lrow
For y = 2 To lrow
If tb2.Cells(x, 1).Value = tb.Cells(y, 1).Value Then
tb2.Cells(x, 2).Value = tb.Cells(y, 2).Value
End If
Next y
Next x
End Sub
If i'm not mistaken, for each product_code in sheet2 col A, I'm looping through all the product codes in sheet1 and getting back the LAST value it finds, instead of the sum of all values... I understand why it doesn't work, I just don't know how to fix it.
Any help would be much appreciated. Thanks!
This statement overwrites the value of tb2.Cells(x, 2).Value at each iteration:
tb2.Cells(x, 2).Value = tb.Cells(y, 2).Value
Instead, I think you need to keep adding to it:
tb2.Cells(x, 2).Value = tb2.Cells(x, 2).Value + tb.Cells(y, 2).Value
But I don't like the looks of your double-loop which uses only one lrow variable to represent the "last row" on the two different worksheets, that could be causing some issues.
Or, in your loop do something like this which I think will avoid the duplicate sum. Still, assumes the second worksheet doesn't initially have any value in
' Base our lRow on Sheet2, we don't care how many rows in Sheet1.
lrow = tb2.Cells(tb2.Rows.Count, 1).End(xlUp).Row
Dim cl as Range
Set cl = tb.Cells(2,1) 'Our initial cell value / ID
For x = 2 to lRow '## Look the rows on Sheet 2
'## Check if the cell on Sheet1 == cell on Sheet2
While cl.Value = tb2.Cells(x,1).Value
'## Add cl.Value t- the tb2 cell:
tb2.Cells(x, 2).Value = tb2.Cells(x, 2).Value + cl.Offset(0,1).Value
Set cl = cl.Offset(1) '## Reassign to the next Row
Wend
Next
But it would be better to omit the double-loop and simply use VBA to do 1 of the following:
1. Insert The Formula:
(See Scott Holtzman's answer).
This approach is better for lots of reasons, not the least of which is that the WorksheetFunction is optimized already, so it should arguably perform better though on a small dataset the difference in runtime will be negligible. The other reason is that it's stupid to reinvent the wheel unless you have a very good justification for doing so, so in this case, why write your own version of code that accomplishes what the built-in SumIf already does and is specifically designed to do?
This approach is also ideal if the reference data may change, as the cell formulas will automatically recalculate based on the data in Sheet1.
2. Evaluate the formula & replace with values only:
If you prefer not to retain the formula, then a simple Value assignment can remove the formula but retain the results:
With .Range(.Range("B2"), .Range("A2").End(xlDown).Offset(, 1))
.FormulaR1C1 = "=SUMIF(Sheet1!C[-1]:C[-1],RC[-1],Sheet1!C:C)"
.Value = .Value 'This line gets rid of the formula but retains the values
End With
Use this approach if you will be removing Sheet1, as removing the referents will break the formula on Sheet2, or if you otherwise want the Sheet2 to be a "snapshot" instead of a dynamic summation.
If you really need this automated, take advantage of VBA to place the formula for you. It's very quick and easy using R1C1 notation.
Complete code (tested):
Dim tb As Worksheet
Dim tb2 As Worksheet
Set tb = Sheets("sheet1")
Set tb2 = Sheets("sheet2")
Dim lrow As Long
lrow = tb.Cells(tb.Rows.Count, 1).End(xlUp).Row
tb.Range("A2:A" & lrow).Copy tb2.Range("A2")
With tb2
.Range("A2").CurrentRegion.RemoveDuplicates 1
With .Range(.Range("B2"), .Range("A2").End(xlDown).Offset(, 1))
.FormulaR1C1 = "=SUMIF(Sheet1!C[-1]:C[-1],RC[-1],Sheet1!C:C)"
End With
End With
Note that with R1C1 notation the C and R are not referring to column or row letters . Rather they are the column and row offsets from the place where the formula is stored on the specific worksheet. In this case Sheet!C[-1] refers to the entire A column of sheet one, since the formula is entered into column B of sheet 2.
I wrote a neat little algorithm (if you can call it that) that does what you want them spits out grouped by totals into another sheet. Basically it loops through the first section to get unique names/labels and stores them into an array. Then it iterates through that array and adds up values if the current iteration matches what the current iteration of the nested loop position.
Private Sub that()
Dim this As Variant
Dim that(9, 1) As String
Dim rowC As Long
Dim colC As Long
this = ThisWorkbook.Sheets("Sheet4").UsedRange
rowC = ThisWorkbook.Sheets("Sheet4").UsedRange.Rows.Count
colC = ThisWorkbook.Sheets("Sheet4").UsedRange.Columns.Count
Dim thisname As String
Dim i As Long
Dim y As Long
Dim x As Long
For i = LBound(this, 1) To UBound(this, 1)
thisname = this(i, 1)
For x = LBound(that, 1) To UBound(that, 1)
If thisname = that(x, 0) Then
Exit For
ElseIf thisname <> that(x, 0) And that(x, 0) = vbNullString Then
that(x, 0) = thisname
Exit For
End If
Next x
Next i
For i = LBound(that, 1) To UBound(that, 1)
thisname = that(i, 0)
For j = LBound(this, 1) To UBound(this, 1)
If this(j, 1) = thisname Then
thisvalue = thisvalue + this(j, 2)
End If
Next j
that(i, 1) = thisvalue
thisvalue = 0
Next i
ThisWorkbook.Sheets("sheet5").Range(ThisWorkbook.Sheets("Sheet5").Cells(1, 1), ThisWorkbook.Sheets("Sheet5").Cells(rowC, colC)).Value2 = that
End Sub
Yay arrays
I'm trying to use VBA for a find/replace. The goal is to iterate through a "Data_Pairs" sheet which contains all the pairs to find/replace, and to find/replace those pairs only in Column A and only in a specified range of sheets in the workbook (which does not include "Data_Pairs").
For some reason, every matching value is replaced, regardless of which column it's in. Values are also replaced in sheets whose index falls outside the defined range.
Any help would be greatly appreciated.
I'm using the following code:
Sub Replace_Names()
Dim row As Integer
Dim row2 As Integer
Dim sheet As Integer
Dim findThisValue As String
Dim replaceWithThisValue As String
For row = 1 To 10
Worksheets("Data_Pairs").Activate
findThisValue = Cells(row, "A").Value
replaceWithThisValue = Cells(row, "B").Value
For sheet = 2 To 10
Worksheets(sheet).Columns("A").Replace What:= findThisValue, Replacement:=replaceWithThisValue
Next sheet
Next row
End Sub
To give a concrete example of the issue: if Data_Pairs A1 = A and Data_Pairs B1 = 1, every single value of 1 in the entire workbook is replaced with A.
I observe this works as-expected in Excel 2010, echoing Greg and chancea's comments above.
HOWEVER, I also observe that if you have previously opened the FIND dialog (for example you were doing some manual find/replace operations) and changed scope to WORKBOOK, then the observed discrepancies will occur, as discussed here:
http://www.ozgrid.com/forum/showthread.php?t=118754
This may be an oversight, because it does not appear to have ever been addressed. While the Replace dialog allows you to specify Workbook versus Worksheet, there is no corresponding argument you can pass to the Replace method (documentation).
Implement the hack from the Ozgrid thread -- for some reason, executing the .Find method seems to reset that. This appears to work:
Sub Replace_Names()
Dim row As Integer
Dim row2 As Integer
Dim sheet As Integer
Dim findThisValue As String
Dim replaceWithThisValue As String
Dim rng As Range
For row = 1 To 10
Worksheets("Data_Pairs").Activate
findThisValue = Cells(row, "A").Value
replaceWithThisValue = Cells(row, "B").Value
For sheet = 2 To 3
Set rng = Worksheets(sheet).Range("A:A")
rng.Find ("*") '### HACK
rng.Replace What:=findThisValue, Replacement:=replaceWithThisValue
Next sheet
Next row
End Sub
You have a Worksheets("Data_Pairs").Activate inside your For ... Next loop. That would seem to indicate that the command is called 9× more that it has to be. Better not to reply on .Activate to provide the default parent of Cells.
Sub Replace_Names()
Dim rw As long, ws As long
Dim findThis As String, replaceWith As String
with Worksheets(1)
For rw = 1 To 10
findThis = .Cells(rw , "A").Value
replaceWith = .Cells(rw , "B").Value
For ws = 2 To 10 ' or sheets.count ?
with Worksheets(ws)
.Columns("A").Replace What:= findThis, Replacement:=replaceWith
end with
Next ws
Next rw
end with
End Sub
See How to avoid using Select in Excel VBA macros for more on getting away from Select and Acticate.