I'm currently struggling with the following problem
I'm trying to implement an input box where a user can input the character of the column.
After that, i dont know how to convert this into a number to use it in the Worksheet.Cells Method
For example: The User inputs "B", so the program saves it in a variable named x and converts it into a number so it can be used as Worksheet.Cells(Row, X)
Is there any method or does someone has an idea how to do this?
Cells() is your friend.
Don't overthink this.
Cells(1, 1) = "jello" ' changes cell A1
Cells(2, "AZ") = "too much jello" ' changes cell AZ2
The second argument of Cells() can be either a number or the alpha column header.
B is the second column, so you can use the expression (based on ASCII):
Sub main()
Dim s As String
s = "AB"
example s
End Sub
Sub example(s As String)
Dim colNum As Integer
Dim i As Integer
i = 1: colNum = 0
While (Mid(s, i, 1) <> "")
colNum = colNum * 26 + (Asc(UCase(Mid(s, i, 1))) - Asc("A") + 1)
i = i + 1
Wend
MsgBox colNum
End Sub
Function getColNum(colLetter As String) As Long
On Error Resume Next 'will return 0 if letter > last col
getColNum = Range(colLetter & "1").Column
End Function
Related
I'm trying to look for values to create a final ticket number for a ticket reconciliation process. This is what should happen:
subroutine looks for a value in cell "Gx"
if it finds a value
pass value to function to strip out letters, convert to a number, pass back to subroutine to place in
cell "Ax"
if there is no value
pass value of "Cx" to function etc.
This loops through the number cells I have in my worksheet based on the number of rows filled in a separate column.
The function works fine by itself in the worksheet, but when I pass it a value from the subroutine column A fills up with the number of the row ie. A37=37, A8=8. I don't think I'm passing the argument correctly to the function, but I'm not certain. Here's the code for the subroutine and the function:
Sub final_ticket_number()
Dim rw As Integer
Dim i As Integer
'header label
Range("A1").Value = "Final Ticket #"
'set number of rows for loop
With Worksheets(1)
rw = .Range("B2").End(xlDown).Row
End With
'check col G for empty, use col C as backup
For i = 2 To rw
If Not IsEmpty(Cells(i, "G")) Then
'strip out letters in col G, place in col A
Cells(i, "A").Value = getNumeric("G" & i)
Else
'strip out letters in col C, place in col A
Cells(i, "A").Value = getNumeric("C" & i)
End If
Next i
End Sub
Function getNumeric(cellRef As String) As Long 'remove letters from ticket numbers
Dim stringLength As Integer
Dim i As Byte
Dim Result As String
stringLength = Len(cellRef)
'loops through each character in a cell to evaluate if number or not
For i = 1 To stringLength
If IsNumeric(Mid(cellRef, i, 1)) Then
Result = Result & Mid(cellRef, i, 1)
End If
Next i
'convert remaining characters to number
getNumeric = CLng(Result)
End Function
What am I missing?
As I understand it, the only thing that is wrong is your Len (cellRef), here you are only passing the range and not his value. See how I did it, I had to specify the spreadsheet, do the same that will work.
Use debug.print to see the outputs of the variables. Write in the code "debug.print XvariableX" and in the immediate check (Ctrl + G) you see the value assigned to the variable. good luck.
Sub final_ticket_number()
Dim rw As Integer
Dim i As Integer
Range("A1").Value = "Final Ticket #"
With Worksheets(1)
rw = .Range("B2").End(xlDown).Row
End With
For i = 2 To rw
If Not IsEmpty(Cells(i, "G")) Then
Cells(i, "A").Value = getNumeric("G" & i)
Else
Cells(i, "A").Value = getNumeric("C" & i)
End If
Next i
End Sub
Function getNumeric(cellRef As String) As Long 'remove letters from ticket numbers
Dim stringLength As Integer
Dim i As Byte
Dim Result As String
Dim Wrs As String
Wrk = ActiveWorkbook.Name
Workbooks(Wrk).Activate
Wrs = ActiveSheet.Name
stringLength = Len(Workbooks(Wrk).Worksheets(Wrs).Range(cellRef))
For i = 1 To stringLength
If IsNumeric(Mid(Workbooks(Wrk).Worksheets(Wrs).Range(cellRef), i, 1)) Then
Result = Result & Mid(Workbooks(Wrk).Worksheets(Wrs).Range(cellRef), i, 1)
End If
Next i
getNumeric = CLng(Result)
End Function
I have an sheet with column D where I have an ID in the format of
MG-456789 ; MG-Series ; MG-.
The above are the cases how the ID looks in my column D.
I would prefer to have an code, which works in such a way that, it checks for the number after MG - if there are 6 digits present, then it is valid, else I want it to be printed as invalid in column S.
For eg: if there is an ID like ; MG-Se then I want column S printed as invalid ; or MG- as invalid ; something like MG-456789 then its accepted and don't need to be printed in column S.
I tried to go through net and found Isnumeric can be used to check for the number in the cell. I could visualize for particular number but not a code for generic case like mine.
Can anyone help me how I can proceed with this case? any lead would be helpful.
Try this code.
Sub test()
Dim vDB, vR()
Dim Ws As Worksheet
Dim n As Long, i As Long, s As String
Set Ws = ActiveSheet
With Ws
vDB = .Range("d2", .Range("d" & Rows.Count).End(xlUp))
End With
n = UBound(vDB, 1)
ReDim vR(1 To n, 1 To 1)
For i = 1 To n
s = Replace(vDB(i, 1), "MG-", "")
If Len(s) = 6 And IsNumeric(s) Then
Else
vR(i, 1) = "false"
End If
Next i
Ws.Range("s2").Resize(n) = vR
End Sub
It's easy using Like operator:
If myString Like "MG-[0-9][0-9][0-9][0-9][0-9][0-9]" Then
MsgBox "Valid ID"
Else
MsgBox "Invalid ID"
End If
[0-9] stands for any digit, thus, it will match any string starting with MG- and followed by six digits.
You could also write it as a function to be called as
=CheckMG1(D2)
and pulled down
Function CheckMG1(s As String) As String
If Len(s) = 9 And Left(s, 3) = "MG-" And IsNumeric(Right(s, 6)) Then
CheckMG1 = "OK"
Else
CheckMG1 = "Invalid"
End If
End Function
A simpler code for you to try,
Sub MG()
Dim i As Long
For i = 1 To Cells(Rows.Count, "D").End(xlUp).Row
If IsNumeric(Replace(Cells(i, "D"), "MG-", "")) Then
Cells(i, "S") = "Valid"
Else
Cells(i, "S") = "InValid"
End If
Next i
End Sub
Say, my original data block is worksheets(1).range("A1:C100"), and I'd like to stack the columns of this block into a single column, that is, I first put first column, then the second column goes below, and finally the third column. In the end, I should have a single column, say being put in worksheets(2).range("A1:A300"). I wonder if there's any smart and fast algorithm to achieve this?
Without VBA, In Sheet2 cell A1 enter:
=OFFSET(Sheet1!$A$1,MOD(ROWS($1:1)-1,100),ROUNDUP(ROWS($1:1)/100,0)-1,)
and copy down.
and with VBA
Sub copy_table_to_column()
Dim s As String
s = "=OFFSET(Sheet1!$A$1,MOD(ROWS($1:1)-1,100),ROUNDUP(ROWS($1:1)/100,0)-1,)"
With Worksheets("Sheet2").Range("A1:A300")
.Formula = s
.Value = .Value
End With
End Sub
There might be a better way, but I usually do it with an Offset
I=0
For Each A in Worksheets(1).Range("A1:A100").Cells
Worksheets(2).Range("A1").Offset(I,0) = A.Value
I = I + 1
Next
For Each B in Worksheets(1).Range("B1:B100").Cells
Worksheets(2).Range("A1").Offset(I,0) = B.Value
I = I + 1
Next
For Each C in Worksheets(1).Range("C1:C100").Cells
Worksheets(2).Range("A1").Offset(I,0) = C.Value
I = I + 1
Next
This might be good enough for you...
Hope it helps.
Option Explicit
'Define the test function...
Sub test()
Dim vData As Variant
Dim r As Range
Set r = Sheet1.Range("A1:C100")
vData = ConcatinateColumns(r)
End Sub
'Define the function to concatinate columns.
Public Function ConcatinateColumns(ByVal Data As Range)
Dim vTemp As Variant
Dim i As Integer, j As Long, k As Long
'Get the data for each cell to a variant.
vTemp = Data.Value
ReDim vData(1 To (UBound(vTemp, 1) - LBound(vTemp, 1) + 1) * (UBound(vTemp, 2) - LBound(vTemp, 2) + 1), 1 To 1) As Variant
For i = LBound(vTemp, 2) To UBound(vTemp, 2)
For j = LBound(vTemp, 1) To UBound(vTemp, 1)
k = k + 1
vData(k, LBound(vData, 1)) = vTemp(j, i)
Next
Next
ConcatinateColumns = vData
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)
This might be a little tricky, even with VBA...
I have comma separated lists in cells based on start times over 5 minutes intervals but I need to remove times that are only 5 apart.
The numbers are text, not time at this point. For example, one list would be 2210, 2215, 2225, 2230, 2240 (the start times).
In this case, 2215 and 2230 should be removed but I also need to remove the opposite numbers (i.e.,2210 and 2225) in other cases (the end times).
Someone helped me with my specs:
A cell contains times: t(1), t(2), t(3), ... t(n). Starting at time t(1), each value in the list is examined. If t(x) is less than 6 minutes after t(x-1) delete t(x) and renumber t(x+1) to t(n).
Input:
2210, 2215, 2225, 2230, 2240
Output:
column1: 2210
column2: 2240
This does what I think you require.
Option Explicit
Sub DeleteSelectedTimes()
Dim RowCrnt As Long
RowCrnt = 2
Do While Cells(RowCrnt, 1).Value <> ""
Cells(RowCrnt, 1).Value = ProcessSingleCell(Cells(RowCrnt, 1).Value, 1)
Cells(RowCrnt, 2).Value = ProcessSingleCell(Cells(RowCrnt, 2).Value, -1)
RowCrnt = RowCrnt + 1
Loop
End Sub
Function ProcessSingleCell(ByVal CellValue As String, ByVal StepFactor As Long) As String
Dim CellList() As String
Dim CellListCrntStg As String
Dim CellListCrntNum As Long
Dim InxCrnt As Long
Dim InxEnd As Long
Dim InxStart As Long
Dim TimeCrnt As Long ' Time in minutes
Dim TimeLast As Long ' Time in minutes
CellList = Split(CellValue, ",")
If StepFactor = 1 Then
InxStart = LBound(CellList)
InxEnd = UBound(CellList)
Else
InxStart = UBound(CellList)
InxEnd = LBound(CellList)
End If
CellListCrntStg = Trim(CellList(InxStart))
If (Not IsNumeric(CellListCrntStg)) Or InStr(CellListCrntStg, ".") <> 0 Then
' Either this sub-value is not numeric or if contains a decimal point
' Either way it cannot be a time.
ProcessSingleCell = CellValue
Exit Function
End If
CellListCrntNum = Val(CellListCrntStg)
If CellListCrntNum < 0 Or CellListCrntNum > 2359 Then
' This value is not a time formatted as hhmm
ProcessSingleCell = CellValue
Exit Function
End If
TimeLast = 60 * (CellListCrntNum \ 100) + (CellListCrntNum Mod 100)
For InxCrnt = InxStart + StepFactor To InxEnd Step StepFactor
CellListCrntStg = Trim(CellList(InxCrnt))
If (Not IsNumeric(CellListCrntStg)) Or InStr(CellListCrntStg, ".") <> 0 Then
' Either this sub-value is not numeric or if contains a decimal point
' Either way it cannot be a time.
ProcessSingleCell = CellValue
Exit Function
End If
CellListCrntNum = Val(CellListCrntStg)
If CellListCrntNum < 0 Or CellListCrntNum > 2359 Then
' This value is not a time formatted as hhmm
ProcessSingleCell = CellValue
Exit Function
End If
TimeCrnt = 60 * (CellListCrntNum \ 100) + (CellListCrntNum Mod 100)
If Abs(TimeCrnt - TimeLast) < 6 Then
' Delete unwanted time from list
CellList(InxCrnt) = ""
Else
' Current time becomes Last time for next loop
TimeLast = TimeCrnt
End If
Next
CellValue = Join(CellList, ",")
If Left(CellValue, 1) = "," Then
CellValue = Mid(CellValue, 2)
CellValue = Trim(CellValue)
End If
Do While InStr(CellValue, ",,") <> 0
CellValue = Replace(CellValue, ",,", ",")
Loop
ProcessSingleCell = CellValue
End Function
Explanation
Sorry for the lack of instructions in the first version. I assumed this question was more about the technique for manipulating the data than about VBA.
DeleteSelectedTimes operates on the active worksheet. It would be easy to change to work on a specific worksheet or a range of worksheets if that is what you require.
DeleteSelectedTimes ignores the first row which I assume contains column headings. Certainly my test worksheet has headings in row 1. It then processes columns A and B of every row until it reaches a row with an empty column A.
ProcessSingleCell has two parameters: a string and a direction. DeleteSelectedTimes uses the direction so values in column A are processed left to right while values in column B are processed right to left.
I assume the #Value error is because ProcessSingleCell does not check that the string is of the format "number,number,number". I have changed ProcessSingleCell so if the string is not of this format, it does change the string.
I have no clear idea of what you do or do not know so come back with more questions as necessary.
Still not clear on your exact requirements, but this might help get you started....
Sub Tester()
Dim arr
Dim out As String, x As Integer, c As Range
Dim n1 As Long, n2 As Long
For Each c In ActiveSheet.Range("A1:A10")
If InStr(c.Value, ",") > 0 Then
arr = Split(c.Value, ",")
x = LBound(arr)
out = ""
Do
n1 = CLng(Trim(arr(x)))
n2 = CLng(Trim(arr(x + 1)))
'here's where your requirements get unclear...
out = out & IIf(Len(out) > 0, ", ", "")
If n2 - n1 <= 5 Then
out = out & n1 'skip second number
x = x + 2
Else
out = out & n1 & ", " & n2 'both
x = x + 1
End If
Loop While x <= UBound(arr) - 1
'pick up any last number
If x = UBound(arr) Then
out = out & IIf(Len(out) > 0, ", ", "") & arr(x)
End If
c.Offset(0, 1).Value = out
End If
Next c
End Sub
Obviously many ways to skin this cat ... I like to use collections for this sort of thing:
Private Sub PareDownList()
Dim sList As String: sList = ActiveCell ' take list from active cell
Dim vList As Variant: vList = Split(sList, ",") ' convert to variant array
' load from var array into collection
Dim cList As New Collection
Dim i As Long
For i = 0 To UBound(vList): cList.Add (Trim(vList(i))): Next
' loop over collection removing unwanted entries
' (in reverse order, since we're removing items)
For i = cList.Count To 2 Step -1
If cList(i) - cList(i - 1) = 5 Then cList.Remove (i)
Next i
' loop to put remaining items back into a string fld
sList = cList(1)
For i = 2 To cList.Count
sList = sList + "," + cList(i)
Next i
' write the new string to the cell under the activecell
ActiveCell.Offset(1) = "'" + sList ' lead quote to ensure output cell = str type
End Sub
' If activecell contains: "2210, 2215, 2225, 2230, 2240"
' the cell below will get: "2210,2225,2240"
Note: this sample code should be enhanced w some extra validation & checking (e.g. as written assumes all good int values sep by commas & relies in implicit str to int conversions). Also as written will convert "2210, 2215, 2220, 2225, 2230, 2240" into "2210, 2040" - you'll need to tweak the loop, loop ctr when removing an item if that's not what you want.