I've looked hight and low for a correct method, but I'm having so much trouble.
I'm trying to add another row with data on the end of my table, but all it keeps doing is adding another row but doesn't add the actual data.
Sub CommandButton1_Click()
Dim lastRow As Long
Dim iHeader As Integer
Dim strData As String
strname = InputBox(prompt:="Enter data")
Set myTable = ActiveSheet.ListObjects("Table1")
ActiveSheet.ListObjects("Table1").ListRows.Add
With ActiveSheet.ListObjects("Table1")
lastRow = ActiveSheet.ListObjects("Table1").ListRows.Count
End With
ActiveSheet.Cells(lastRow, "M").Value = strData
End Sub
It will only add a row to the table but it will not add the strData value no matter what I try. The Column its using for testing purposes is "M"
Any help would be appreciated
Looks like a typographical error: (Which is why you should always use Option Explicit)
Option Explicit
Sub CommandButton1_Click()
Dim lastRow As Long
Dim iHeader As Integer
Dim strData As String
strData = InputBox(prompt:="Enter data") 'Fixed variable here
Set myTable = ActiveSheet.ListObjects("Table1")
With myTable
.ListRows.Add
lastRow = .ListRows.Count
End With
ActiveSheet.Cells(lastRow, "M").Value = strData
End Sub
Related
Assistance required on this one, its probably something easy but im still developing when it comes to VBA.
I have a userform that is used to update a log of requests, i want it to operate so that it looks down column A to establish the Last row and the Last used reference number. Once the new submission is entered i want it to populate to the next blank row whilst auto incrementing the reference number. The reference Numbers are formatted as below.
Column A (RefNo)
Column B LA
LSI-1
Data
LSI-2
Data
LSI-3
Data
LSI-4
Data
etc..
Data
just for reference, due to the logs headers etc, LSI-1 starts on row 6.
Private Sub UserForm_Initialize()
Me.Height = 424
Me.Width = 438
Me.Zoom = 100
Txt_DateLogged.Value = Format(Date, "dd/mm/yyyy")
Txt_Month.Value = Format(Date, "MMM-YY")
Call CBO_Supplier_Items
Call CBO_SRM_Items
Call CBO_Cause_Items
Dim ws As Worksheet
Dim i As Long
Set ws = ThisWorkbook.Sheets("LSI Log")
With ws
i = .Rows.Count
lstdt = .Range("A" & i).End(xlUp).Value
Me.Txt_IssueNum.Value = "LSI-" & lstdt + 1
End With
End Sub
On the userform there is a textbox Txt_IssueNum which is not enabled but i want it to be populated with the new reference number during the userform Initialising.
When i run my code above i get the Error Type Mismatch error message.
Any thoughts where im going wrong with it?
Thanks in advance.
Threw this together so might not be the best code for finding the max (end of the day).....
With your data as below (not sorted, different text in there)
Option Explicit
Public Sub Test()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
'Set reference to your data range.
Dim TheData As Range
With ws
Set TheData = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
'Ask for the next ID relevant to LSI- type.
MsgBox GetNextID(TheData, "LSI-")
End Sub
Public Function GetNextID(MyDataRange As Range, StartText As String) As String
Dim IDCollection As Collection
Set IDCollection = New Collection
'Put all numbers relevant to the correct type into a collection.
Dim itm As Variant
For Each itm In MyDataRange
If Left(itm, Len(StartText)) = StartText Then
'Remove the StartText, turn the number into a value.
IDCollection.Add Val(Replace(itm, StartText, ""))
End If
Next itm
'Find the maximum number.
Dim MaxNum As Long
For Each itm In IDCollection
If itm > MaxNum Then MaxNum = itm
Next itm
'Add the StartText back and return the result.
GetNextID = StartText & MaxNum + 1
End Function
Results when looking for "LSI-" and then "AB-":
Extract Trailing Integers
A Test
Use this test sub before using the function in your sub.
Sub Test()
Debug.Print GetNewId
End Sub
The Function
Adjust the first cell "A2".
Function GetNewId() As String
Const ID_PREFIX As String = "LSI-"
Dim IdNumbers()
With ThisWorkbook.Sheets("LSI Log")
Dim EvalString As String
With .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
EvalString = "Value(Right(" & .Address _
& ",LEN(" & .Address & ")-" & Len(ID_PREFIX) & "))"
End With
IdNumbers = .Evaluate(EvalString)
End With
Dim IdNumber, MaxNumber As Long
For Each IdNumber In IdNumbers
If IsNumeric(IdNumber) Then
If IdNumber > MaxNumber Then MaxNumber = IdNumber
End If
Next IdNumber
Dim NewId As String: NewId = ID_PREFIX & CStr(MaxNumber + 1)
GetNewId = NewId
End Function
Your New Sub
Private Sub UserForm_Initialize()
Me.Height = 424
Me.Width = 438
Me.Zoom = 100
Txt_DateLogged.Value = Format(Date, "dd/mm/yyyy")
Txt_Month.Value = Format(Date, "MMM-YY")
Call CBO_Supplier_Items
Call CBO_SRM_Items
Call CBO_Cause_Items
Me.Txt_IssueNum.Value = GetNewId
End Sub
I am trying to check if a value is in a certain range. If that value appears, the corresponding data to that enty is copied to another sheet. The trick is it has to be dynamically determined because the column size varies from input sheet to input sheet. In Java the hasNext() function can be used. I think that VBA's most similar function would be Sheet1.Column.End(xlup). How is the best way to determine the end of a column for the test condition of a do while loop in vba?
Pseudo example:
'This is part of a nested loop, this segment traverses the column looking for 'specified data.
Do While (!Sheets(inputSheetName).SyntaxToDetermineEndOfColumn))
If(someCell = someValue)
Copy values from the corresponding row to fields in newSheet
End If
Next r 'This increments the row within the current column
Loop
Next c 'This increments to the next column of data
Say we have data like:
We want to find happiness in the first two columns and retrieve the column C value in that row:
Sub LookingForHappiness()
Dim i As Long, j As Long, N As Long, h As String
h = "happiness"
For i = 1 To 2
N = Cells(Rows.Count, i).End(xlUp).Row
For j = 1 To N
If Cells(j, i).Value = h Then
MsgBox Cells(j, "C").Value
MsgBox Cells(j, i).Address(0, 0)
Exit Sub
End If
Next j
Next i
End Sub
There are two parts to your question:
The first part about finding the last used row is easialy found with a quick Google: Error in finding last used cell in VBA
To loop from start to end of column, use this:
Dim ws1 as Worksheet, LastRow as Long, CurRow as Long, DataFind as String
Set ws1 = Sheets("Name of Sheet")
LastRow = ws1.Range("Column letter" & ws1.Rows.Count).End(xlUp).Row
DataFind = Inputbox("What are you looking for?")
For CurRow = 1 to LastRow
If ws1.Range("Column Letter" & CurRow).Value = DataFind Then
ws1.Range("Column Letter" & CurRow).EntireRow.Copy
Sheets("Dest Sheet").Range("Whatever").PasteSpecial
End If
Next CurRow
You might find this useful: http://support.microsoft.com/kb/830287
But what I personally do in this situation involves a bit more code, but is flexible and fast. First create a class and call it "RangeInfo". Then past this:
Option Explicit
Private Type Properties
Intialized As Boolean
Object As Excel.Range
RowBottom As Long
RowCount As Long
RowTop As Long
ColumnLeft As Long
ColumnCount As Long
ColumnRight As Long
End Type
Private this As Properties
Public Property Get Initialized() As Boolean
Initialized = this.Intialized
End Property
Public Property Get Object() As Excel.Range
Set Object = this.Object
End Property
Public Property Get ColumnLeft() As Long
ColumnLeft = this.ColumnLeft
End Property
Public Property Get ColumnCount() As Long
ColumnCount = this.ColumnCount
End Property
Public Property Get ColumnRight() As Long
ColumnRight = this.ColumnRight
End Property
Public Property Get RowBottom() As Long
RowBottom = this.RowBottom
End Property
Public Property Get RowCount() As Long
RowCount = this.RowCount
End Property
Public Property Get RowTop() As Long
RowTop = this.RowTop
End Property
Public Sub Initialize(ByRef rng As Excel.Range)
With this
Set .Object = rng
.RowTop = rng.row
.RowCount = rng.Rows.Count
.RowBottom = .RowTop + .RowCount - 1&
.ColumnLeft = rng.Column
.ColumnCount = rng.Columns.Count
.ColumnRight = .ColumnLeft + this.ColumnCount - 1&
.Intialized = True
End With
End Sub
Public Sub Clear()
Dim emptyProperties As Properties
this = emptyProperties
End Sub
Private Sub Class_Terminate()
Set this.Object = Nothing
End Sub
Then for your code, use this:
Option Explicit
Public Sub Example()
'Set these as needed:
Const sheetName As String = "MySheet"
Const columnNumber As Long = 2&
Const criteria As String = "*foo#"
Dim wsIn As Excel.Worksheet
Dim wbOut As Excel.Workbook
Dim wsOut As Excel.Worksheet
Dim ri As RangeInfo
Dim rowIn As Long
Dim rowOut As Long
Dim col As Long
Set wbOut = Excel.Workbooks.Add
Set wsOut = wbOut.Worksheets(1)
Set wsIn = Excel.Worksheets(sheetName)
Set ri = New RangeInfo
ri.Initialize wsIn.UsedRange
rowOut = 1&
With ri
For rowIn = .RowTop To .RowBottom
If wsIn.Cells(rowIn, columnNumber) Like criteria Then
rowOut = rowOut + 1&
For col = .ColumnLeft To .ColumnRight
wsOut.Cells(rowOut, col).Value = wsIn.Cells(rowIn, col).Value
Next
End If
Next
End With
End Sub
I am importing some date to worksheet which needs to be ranged for validation and reference in other worksheets.
Say I have 4 columns in worksheet(WS1) but the row count is dynamic on every import. How can i range the columns(A:D)?
Please help.
Regards,
Mani
Use a lastRow variable to determine the last row. I included a few examples of this. Also on this example is a lastCol variable.. You can use this if the number of Columns is dynamic as well.
Private Sub lastRow()
Dim lastRow As Long
Dim lastCol As Long
Dim sheet As String
sheet = "WS1"
lastRow = Sheets(sheet).Range("A" & Rows.Count).End(xlUp).row 'Using Range()
lastRow = Sheets(sheet).Cells(Rows.Count, "A").End(xlUp).row 'Using Cells()
lastCol = Sheets(sheet).Cells(2, Columns.Count).End(xlToLeft).Column
End Sub
You can loop through your sheet easily enough using variables also. Using Cells(row,col) instead of Range(A1). you can use numbers or a letter in quotes for the column as shown in the example.
This example looks at WS1 and matches someValue. If the value in Column A of WS1 = somevalue, the record is copied to a "Master" Sheet.
Sub LoopExample()
Dim mRow As Long 'used for a master row
For lRow = 2 To lastRow
If Sheets(sheet).Cells(lRow, 1) = someValue Then
'perform something here like this. Copy columns A:D to the Master Sheet if match
For lCol = 1 To 4 'or you could go 1 to lastCol if you needed it dynamic
Sheets("MASTER").Cells(mRow, lCol) = Sheets(sheet).Cells(lRow, lCol) 'mRow as Row on Master
Next lCol
mRow = mRow + 1 'Increment the Master Row
End If
Next lRow
End Sub
Thanks anyways. But what i wanted was just to Name ranges the columns in worksheet.
I have already accomplished the copy and paste (Loading data b/w worksheets).
This is what i wanted.
vRowCount = DestWorkSheet.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
vColCount = DestWorkSheet.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Column
DestWorkSheet.usedRange.Columns.AutoFit
AddNamedRange Dest_RATES, DATA_Dest_RATES
Where AddNamedRange is a function,
Public Sub AddNamedRange(ByVal sheetCodeName As String, ByVal namedRange As String)
Dim rngToBeNamed As Range
Dim ws As Worksheet
On Error GoTo AddNamedRange_Error
Set rngToBeNamed = GetUsedRange(sheetCodeName)
Set ws = rngToBeNamed.Worksheet
ws.Names.Add name:=namedRange, RefersTo:=ws.Range(rngToBeNamed.Address)
On Error GoTo 0
Exit Sub
AddNamedRange_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure AddNamedRange of Module UtilitiesRange"
End Sub
Regards,
Mani
Seems like you could just use something like this in the sheet module:
Private Sub Worksheet_Change(ByVal target As Range)
Dim i As Long
Dim NamesOfNames(1 To 4) As String
NamesOfNames(1) = "NameOfColumn1"
NamesOfNames(2) = "NameOfColumn2"
NamesOfNames(3) = "NameOfColumn3"
NamesOfNames(4) = "NameOfColumn4"
For i = 1 To 4
ThisWorkbook.Names.Add Name:=NamesOfNames(i), _
RefersTo:=Range(Cells(1, i), Cells(Cells(Rows.Count, i).End(xlUp).Row, i))
Next i
End Sub
I have a large Excel file and I need to replace all values in 12 columns completely.
Right now, there is a formula in each one of the cells, and I need to replace that formula with my own.
How do I loop through all those columns, knowing at what row it starts but don't know the end row (file is updated constantly). The hack of "A600000" seems overkill.
I am new to VBA and some guidance would be really appreciated.
ActiveSheet.UsedRange is the range of all the used cells on the current sheet.
You can use ActiveSheet.UsedRange.Rows.Count and .Columns.Count to get the height and widht of this range.
Here's a very crude function that hits every cell in the range:
Sub test()
Dim thisRange As Range
Set thisRange = ActiveSheet.UsedRange
With thisRange
For y = 1 To .Rows.Count
For x = 1 To .Columns.Count
thisRange.Cells(y, x).Value = "Formula here"
Next x
Next
End With
End Sub
But what you want may be different, can you be more specific?
The below will accomplish what you need to do. You just need to supply the startRow, .Sheets("Name"), and i arguments. If the columns are all the same length, then UsedRange will work fine if there are not random cells with values outside and below the columns you are interested in. Otherwise, try this in your code (on a throw away copy of your workbook)
Sub GetLastRowInColumn()
Dim ws as Excel.Worksheet
Set ws = Activeworkbook.Sheets("YOURSHEETNAMEHERE")
Dim startRow as long
startRow = 1
Dim lastRow as long
Dim i as long
For i = 1 to 12 'Column 1 to Column 12 (Adjust Accordingly)
lRow = ws.Cells(ws.Rows.Count, i).End(xlUp).Row
ws.Range(ws.Cells(startRow, i), ws.Cells(lRow, i)).Formula = "=Max(1)" 'Sample Formula
Next
End Sub
EDIT : Fixed typo
The below function will build the range with varying length columns. Use the function to return the desired range and fill all related cells in one shot.
Function GetVariantColumnRange(MySheet As Excel.Worksheet, _
TopRow As Long, StartColumn As Long, LastColumn As Long) As Excel.Range
Dim topAddress As String
Dim bottomAddress As String
Dim addressString As String
Dim i As Long
For i = StartColumn To LastColumn
topAddress = MySheet.Cells(TopRow, i).Address
bottomAddress = MySheet.Cells(MySheet.Rows.Count, i).End(xlUp).Address
addressString = addressString & ", " & topAddress & ":" & bottomAddress
Next
addressString = Right(addressString, Len(addressString) - _
InStr(1, addressString, ", ", vbBinaryCompare))
Set GetVariantColumnRange = MySheet.Range(addressString)
End Function
Usage follows...
Sub Test()
Dim myrange As Range
Set myrange = GetVariantColumnRange(ThisWorkbook.Sheets(1), 1, 1, 12)
myrange.Select 'Just a visual aid. Remove from final code.
myrange.Formula = "=APF($Jxx, "string1", "string2") "
End Sub
I am using vba and I have two sheets one is named "Do Not Call" and has about 800,000 rows of data in column A. I want to use this data to check column I in the second sheet, named "Sheet1". If it finds a match I want it to delete the whole row in "Sheet1". I have tailored the code I have found from a similar question here: Excel formula to Cross reference 2 sheets, remove duplicates from one sheet and ran it but nothing happens. I am not getting any errors but it is not functioning.
Here is the code I am currently trying and have no idea why it is not working
Option Explicit
Sub CleanDupes()
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim keyColA As String
Dim keyColB As String
Dim rngA As Range
Dim rngB As Range
Dim intRowCounterA As Integer
Dim intRowCounterB As Integer
Dim strValueA As String
keyColA = "A"
keyColB = "I"
intRowCounterA = 1
intRowCounterB = 1
Set wsA = Worksheets("Do Not Call")
Set wsB = Worksheets("Sheet1")
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Do While Not IsEmpty(wsA.Range(keyColA & intRowCounterA).Value)
Set rngA = wsA.Range(keyColA & intRowCounterA)
strValueA = rngA.Value
If Not dict.Exists(strValueA) Then
dict.Add strValueA, 1
End If
intRowCounterA = intRowCounterA + 1
Loop
intRowCounterB = 1
Do While Not IsEmpty(wsB.Range(keyColB & intRowCounterB).Value)
Set rngB = wsB.Range(keyColB & intRowCounterB)
If dict.Exists(rngB.Value) Then
wsB.Rows(intRowCounterB).delete
intRowCounterB = intRowCounterB - 1
End If
intRowCounterB = intRowCounterB + 1
Loop
End Sub
I apologize if the above code is not in a code tag. This is my first time posting code online and I have no idea if I did it correctly.
I'm embarrassed to admit that the code you shared confused me... anyway for the practice I rewrote it using arrays instead of looping through the sheet values:
Option Explicit
Sub CleanDupes()
Dim targetArray, searchArray
Dim targetRange As Range
Dim x As Long
'Update these 4 lines if your target and search ranges change
Dim TargetSheetName As String: TargetSheetName = "Sheet1"
Dim TargetSheetColumn As String: TargetSheetColumn = "I"
Dim SearchSheetName As String: SearchSheetName = "Do Not Call"
Dim SearchSheetColumn As String: SearchSheetColumn = "A"
'Load target array
With Sheets(TargetSheetName)
Set targetRange = .Range(.Range(TargetSheetColumn & "1"), _
.Range(TargetSheetColumn & Rows.Count).End(xlUp))
targetArray = targetRange
End With
'Load Search Array
With Sheets(SearchSheetName)
searchArray = .Range(.Range(SearchSheetColumn & "1"), _
.Range(SearchSheetColumn & Rows.Count).End(xlUp))
End With
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
'Populate dictionary from search array
If IsArray(searchArray) Then
For x = 1 To UBound(searchArray)
If Not dict.exists(searchArray(x, 1)) Then
dict.Add searchArray(x, 1), 1
End If
Next
Else
If Not dict.exists(searchArray) Then
dict.Add searchArray, 1
End If
End If
'Delete rows with values found in dictionary
If IsArray(targetArray) Then
'Step backwards to avoid deleting the wrong rows.
For x = UBound(targetArray) To 1 Step -1
If dict.exists(targetArray(x, 1)) Then
targetRange.Cells(x).EntireRow.Delete
End If
Next
Else
If dict.exists(targetArray) Then
targetRange.EntireRow.Delete
End If
End If
End Sub
Edit: Because it bothered me, I reread the code that you provided. It confuses me because it isn't written the way I'd have expected and fails unless you're checking string values only. I've added comments to indicate what it's doing in this snippet:
'Checks to see if the particular cell is empty.
Do While Not IsEmpty(wsA.Range(keyColA & intRowCounterA).Value)
'Stores the cell to a range for no good reason.
Set rngA = wsA.Range(keyColA & intRowCounterA)
'Converts the value of the cell to a string because strValueA is a string.
strValueA = rngA.Value
'Checks to see if the string is in the dictionary.
If Not dict.Exists(strValueA) Then
'Adds the string to the dictionary.
dict.Add strValueA, 1
End If
Then later:
'checks the value, not the value converted to a string.
If dict.Exists(rngB.Value) Then
This fails because the Scripting Dictionary does not consider a double to equal a string, even if they would be the same if the double were converted to a string.
Two ways to fix the code you posted, either change the line I just showed to this:
If dict.Exists(cstr(rngB.Value)) Then
Or you can change Dim strValueA As String to Dim strValueA.
Because I had the time, here's a rewrite forgoing the Dictionary and instead using a worksheet function. (Inspired by the Vlookup comment). I'm not sure which would be faster.
Sub CleanDupes()
Dim targetRange As Range, searchRange As Range
Dim targetArray
Dim x As Long
'Update these 4 lines if your target and search ranges change
Dim TargetSheetName As String: TargetSheetName = "Sheet1"
Dim TargetSheetColumn As String: TargetSheetColumn = "I"
Dim SearchSheetName As String: SearchSheetName = "Do Not Call"
Dim SearchSheetColumn As String: SearchSheetColumn = "A"
'Load target array
With Sheets(TargetSheetName)
Set targetRange = .Range(.Range(TargetSheetColumn & "1"), _
.Range(TargetSheetColumn & Rows.Count).End(xlUp))
targetArray = targetRange
End With
'Get Search Range
With Sheets(SearchSheetName)
Set searchRange = .Range(.Range(SearchSheetColumn & "1"), _
.Range(SearchSheetColumn & Rows.Count).End(xlUp))
End With
If IsArray(targetArray) Then
For x = UBound(targetArray) To 1 Step -1
If Application.WorksheetFunction.CountIf(searchRange, _
targetArray(x, 1)) Then
targetRange.Cells(x).EntireRow.Delete
End If
Next
Else
If Application.WorksheetFunction.CountIf(searchRange, targetArray) Then
targetRange.EntireRow.Delete
End If
End If
End Sub