I'm trying to single out a single cell, not a constant as it depends on the data at hand.
Dim lastrow As Integer
Dim sumcount As Integer
'find last non-empty row in column C
lastrow = Cells(Rows.Count, 3).End(xlUp).Row
'add up the int values in the range in C
sumcount = Application.WorksheetFunction.Sum(Range("C17", Cells(lastrow, 3)))
'result goes into the next empty cell in C
Cells(lastrow + 1, 3).Value = sumcount
Now I'm trying to throw the cell Cells(lastrow + 1, 3) into a variable so I can offset it and assign that offset cell a string value.
As far as I know that's only possible with the Range object, but I can't figure out the syntax to achieve that. Is there a property or method I'm not aware of?
Add Column Total and Write to Cell Adjacent To the Right
Option Explicit
Sub Test()
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim sfCell As Range: Set sfCell = ws.Range("C17")
Dim slCell As Range: Set slCell = ws.Cells(ws.Rows.Count, "C").End(xlUp)
Dim srg As Range: Set srg = ws.Range(sfCell, slCell)
Dim sSum As Double: sSum = Application.Sum(srg)
Dim dCell As Range: Set dCell = slCell.Offset(1)
dCell.Value = sSum
dCell.Offset(, 1) = "some string" ' adjacent to the right
End Sub
Cells returns a range object. So you should be able to simply do:
set myrange = cells(lastrow + 1, 3)
myrange.value = "string"
Related
I'm trying to take the first column from my file (all rows except header) and delete text to the left of a colon character but I get a 400 error from VBA. I don't know what's wrong with this code.
As an example A2 (and subsequent cells in the A column) look like this:
Sub cleanLoginTime()
Dim cell As Range
Dim MyRange As Range
Dim tmp As String
LastRow = Cells(Rows.Count, 1).End(xlUp)
Set MyRange = ActiveSheet.Range("A2:A" & LastRow) 'this is your range of data
For Each cell In MyRange.Cells
tmp = cell.Value
'output n - 1 characters from the right
cell.Value = Right(tmp, Len(tmp) - 21)
Next
End Sub
Remove Left From Strings in Column
Sub CleanLoginTime()
Const FindString As String = ":"
Dim FindStringLength As Long: FindStringLength = Len(FindString)
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim rg As Range
Set rg = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp))
Dim cell As Range
Dim FindStringPosition As Long
Dim CellString As String
For Each cell In rg.Cells
CellString = CStr(cell.Value)
FindStringPosition = InStr(CellString, FindString)
If FindStringPosition > 0 Then ' string found
cell.Value = Right(CellString, Len(CellString) _
- FindStringPosition - FindStringLength + 1)
'Else ' string not found; do nothing
End If
Next cell
End Sub
To make it more efficient (faster), you could introduce an array (Data), to access the worksheet minimally.
Sub CleanLoginTimeArray()
Const FindString As String = ":"
Dim FindStringLength As Long: FindStringLength = Len(FindString)
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim rg As Range
Set rg = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp))
Dim Data() As Variant: Data = rg.Value ' works only if more than one cell!
Dim r As Long
Dim FindStringPosition As Long
Dim CellString As String
For r = 1 To UBound(Data, 1)
CellString = CStr(Data(r, 1))
FindStringPosition = InStr(CellString, FindString)
If FindStringPosition > 0 Then ' string found
Data(r, 1) = Right(CellString, Len(CellString) _
- FindStringPosition - FindStringLength + 1)
'Else ' string not found; do nothing
End If
Next r
rg.Value = Data
End Sub
I get a run-time error '13' because you need .row in
lastrow = Cells(Rows.Count, 1).End(xlUp).row
Do any of your cells have a length < 21?
I have a simple loop that should copy ranges form three sheets and stack them on top of each other in another sheet. I define the ranges of each of the three sheets via a cell that counts rows in the Control Sheet.
I do not get an error message, however only the range of the first sheets gets pasted. I troubleshooted already to see if the loop is running until end and indeed it does. I cannot wrap my head around why only the range from the first sheets gets pasted in the final sheet.
Sub Loop()
Dim ws_Sheet As Worksheet, ws As Worksheet
Dim lng_LastRow As Long, lng_LastColumn As Long, lng_LastRowSheet As Long
Dim rng_WorkRange As Range
Dim arrSht, i
Dim counter As Integer
arrSht = Array("a", "b", "c")
Set ws_Sheet = Worksheets("d")
ws_Sheet.Cells.ClearContents
counter = 1
For i = 0 To 2
Set ws = Worksheets(arrSht(i))
lng_LastRow = Worksheets("Control").Range("E" & counter).Value + 1
lng_LastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
lng_LastRowSheet = ws_Sheet.Cells(Rows.Count, 1).End(xlUp).Row
Set rng_WorkRange = ws.Range(ws.Cells(1, 1), ws.Cells(lng_LastRow, lng_LastColumn))
rng_WorkRange.Copy ws_Sheet.Range("A" & lng_LastRowSheet)
counter = counter + 1
Next i
End Sub
The issue is
lng_LastRowSheet = ws_Sheet.Cells(Rows.Count, 1).End(xlUp).Row
is the last used row (the last row that has data).
And then you use that to start pasting
rng_WorkRange.Copy ws_Sheet.Range("A" & lng_LastRowSheet)
so you overwrite the last row of data!
The next free row is lng_LastRowSheet + 1 so you should paste there:
rng_WorkRange.Copy ws_Sheet.Range("A" & (lng_LastRowSheet + 1))
You can also see that in the debug data:
a $A$1:$B$338 to A1
b $A$1:$B$91 to A338
c $A$1:$B$356 to A428
a goes from A1:B338 but you start pasting b in A338 so it overwrites the last row of a.
I gave it a test:
Created worksheet Control with data like
Then created worksheets a, b and c like
with data until row 500 so there is enough.
Then created an empty worksheet d for the output.
And used the following code. Note I have optimized it so it uses meaningful variable names, which is much easier to read, understand and debug.
Option Explicit
Public Sub CopyData()
Dim SheetNames() As Variant
SheetNames = Array("a", "b", "c")
Dim wsDestination As Worksheet
Set wsDestination = ThisWorkbook.Worksheets("d")
wsDestination.Cells.ClearContents
Dim i As Long
For i = 0 To 2
Dim wsSource As Worksheet
Set wsSource = ThisWorkbook.Worksheets(SheetNames(i))
Dim SourceLastRow As Long
SourceLastRow = ThisWorkbook.Worksheets("Control").Range("E" & i + 1).Value + 1
Dim SourceLastColumn As Long
SourceLastColumn = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column
Dim DestinationFreeRow As Long
DestinationFreeRow = wsDestination.Cells(wsDestination.Rows.Count, 1).End(xlUp).Row + 1 ' Last used row +1
Dim SourceRange As Range
Set SourceRange = wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(SourceLastRow, SourceLastColumn))
SourceRange.Copy wsDestination.Range("A" & DestinationFreeRow)
Next i
End Sub
And I get a perfect output like:
Note that in the output I have hidden some rows so you can see eveything is there. This code perfectly does what it is supposed to.
Stack Ranges (Vertically) From Multiple Worksheets
Sub StackRanges()
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Source
Dim sWorksheetNames() As Variant: sWorksheetNames = VBA.Array("a", "b", "c")
' Lookup (Source Last Row)?
Dim lws As Worksheet: Set lws = wb.Worksheets("Control")
Dim llrCell As Range: Set llrCell = lws.Range("E1")
' Destination
Dim dws As Worksheet: Set dws = wb.Worksheets("d")
dws.UsedRange.ClearContents
Dim dfCell As Range: Set dfCell = dws.Range("A1")
Dim sws As Worksheet
Dim srg As Range
Dim slRow As Long
Dim slColumn As Long
Dim i As Long
' Loop.
For i = 0 To UBound(sWorksheetNames)
Set sws = wb.Worksheets(sWorksheetNames(i))
slRow = llrCell.Value + 1
slColumn = sws.Cells(1, sws.Columns.Count).End(xlToLeft).Column
Set srg = sws.Range("A1", sws.Cells(slRow, slColumn))
srg.Copy dfCell
' If you only need to copy values (since you're using '.ClearContents'),
' instead, use the most efficient:
'dfCell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value
Set llrCell = llrCell.Offset(1) ' next source last row lookup cell
Set dfCell = dfCell.Offset(srg.Rows.Count) ' next first dest. cell
Next i
End Sub
The counter and the lng_lastRow variable is too messy.
I repaleced some code as follow：
Sub newLoop()
Dim ws_Sheet As Worksheet, ws As Worksheet
Dim lng_LastRow As Long, lng_LastColumn As Long, lng_LastRowSheet As Long
Dim rng_WorkRange As Range, rng_lastRange As Range
Dim arrSht, i
Dim counter As Integer
arrSht = Array("a", "b", "c")
Set ws_Sheet = Worksheets("Control")
ws_Sheet.Cells.ClearContents
For i = 0 To 2
Set ws = Worksheets(arrSht(i))
Set rng_lastRange = ws_Sheet.Cells(Rows.Count, 1).End(xlUp)
lng_LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
lng_LastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
Set rng_WorkRange = ws.Range(ws.Cells(1, 1), ws.Cells(lng_LastRow, lng_LastColumn))
rng_WorkRange.Copy rng_lastRange.Offset(1, 0)
Next i
End Sub
The macro is working with hard coded inputs but I need loops for debugging and future growth. I don't know the best way to set this up.
Range("b3:b8:) are the cells I would like to loop over.
If cell.value = 1 then
Set var1 = range("a3:aq3") (* This range always has the same row number as cell in loop*)
Set var2 = range("a9:aq9") (*This range always 6 greater than row of cell in loop.)
End if
Next cell
Thanks
Loop Through Rows of a Range
Option Explicit
Sub LoopThroughRows()
Const srgAddress As String = "A3:AQ8"
Const scCol As Long = 2
Const sCriteria As String = "1"
Dim sws As Worksheet: Set sws = ActiveSheet ' improve, e.g.:
'Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
'Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
Dim srg As Range: Set srg = sws.Range(srgAddress) ' last use of 'sws'
Dim srCount As Long: srCount = srg.Rows.Count
Dim srg1 As Range
Dim srg2 As Range
Dim sCell As Range
Dim sr As Long
For Each sCell In srg.Columns(scCol).Cells ' don't forget '.Cells'!
sr = sr + 1 ' monitoring each range row (not worksheet row)
If CStr(sCell.Value) = sCriteria Then ' also avoiding error values
Set srg1 = srg.Rows(sr)
Set srg2 = srg1.Offset(srCount)
' Continue... e.g.:
Debug.Print sr, sCell.Address(0, 0), _
srg1.Address(0, 0), srg2.Address(0, 0)
Else ' not equal to sCriteria (usually do nothing)
' e.g.:
Debug.Print sr, sCell.Address(0, 0), "Nope."
End If
Next sCell
End Sub
Have you tried using a for loop?
Eg:
For Each Cell in Range("B3:B8")
If Cell.Value = 1 Then
Set var1 = range("a3:aq3")
Else
Set var2 = range("a9:aq9")
End If
Next Cell
I am looking for a way to select an entire row but skip the first 3 columns of the same row without using 'range()' command. What command can i use?
You can use a combination of Cells and Resize:
Range.Cells Property
Range.Resize Property
Depending on how you ask the question (skip first column or first column is), you can use the combination as follows:
Option Explicit
Sub EntireSkipColumns()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim rng As Range
Dim FR As Long: FR = 2
Dim LR As Long: LR = 10
Dim i As Long
Dim j As Long: j = 3 ' Skip first 3 columns
For i = FR To LR
Set rng = ws.Cells(i, j + 1).Resize(, ws.Columns.Count - j)
With rng
' To check if the range is correct.
Debug.Print .Address(False, False)
' Cycle Interior ColorIndex
'.Interior.ColorIndex = i
End With
Next i
End Sub
Sub EntireFirstColumn()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim rng As Range
Dim FR As Long: FR = 2
Dim LR As Long: LR = 10
Dim i As Long
Dim j As Long: j = 4 ' Use 4 as the first column
For i = FR To LR
Set rng = ws.Cells(i, j).Resize(, ws.Columns.Count - j + 1)
With rng
' To check if the range is correct.
Debug.Print .Address(False, False)
' Cycle Interior ColorIndex
'.Interior.ColorIndex = i
End With
Next i
End Sub
EDIT:
Set rngTarget = rngTarget.Offset(1) is only used to move each result a row below.
Sub QualifyCellsToo()
Dim wsSource As Worksheet: Set wsSource = ThisWorkbook.Worksheets("Sheet1")
Dim wsTarget As Worksheet: Set wsTarget = ThisWorkbook.Worksheets("Sheet2")
Dim rngSource As Range
Dim rngTarget As Range
' This is wrong:
'Worksheets("sheets1").Range(Cells(3, 4), Cells(3, 9)).Copy _
Worksheets("sheets2").Range(Cells(3, 4), Cells(3, 9))
' You have to qualify 'Cells', too:
Worksheets("Sheet1").Range(Worksheets("Sheet1").Cells(3, 4), _
Worksheets("Sheet1").Cells(3, 9)).Copy _
Worksheets("Sheet2").Range(Worksheets("Sheet2").Cells(3, 4), _
Worksheets("Sheet2").Cells(3, 9))
' This is a long expression, so using variables is preferred.
Set rngSource = wsSource.Range(wsSource.Cells(3, 4), wsSource.Cells(3, 9))
Set rngTarget = wsTarget.Range(wsTarget.Cells(3, 4), wsTarget.Cells(3, 9))
Set rngTarget = rngTarget.Offset(1)
rngTarget.Resize(10).Clear
' Copy values or formulas and formats using same sized ranges.
rngSource.Copy rngTarget
Set rngTarget = rngTarget.Offset(1)
' Copy values or formulas and formats using only the first cell
' of Target Range.
rngSource.Copy rngTarget.Cells(1)
Set rngTarget = rngTarget.Offset(1)
' Copy values
rngTarget.Value = rngSource.Value
Set rngTarget = rngTarget.Offset(1)
' Copy values using target without '.Value'
rngTarget = rngSource.Value
Set rngTarget = rngTarget.Offset(1)
End Sub
I want to convert a range of cells from integer to String. However, since I have so much data, I can't use a standard loop for ranges as it takes too long.
Instead I thought to use the array and convert the desired range(array) into string values.
This is what I tried to do by modifying my standardcode that converts range into string just instead range I would use in the below the array:
Sub CovertToString()
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
Dim sArray As Variant
Dim LastRow As Integer
Dim cell As Variant
With ws
LastRow = .Cells(.rows.Count, 1).End(xlUp).row
sArray = .Range(.Cells(1, 8), .Cells(LastRow, 8))
For Each cell In sArray
cell = "'" & cell.Value
Next
End With
End Sub
Unfortunately, It does not work which I understand as I am not sure how to correct it.
This way will convert the cell formats to Text:
Sub ConvertToString()
Dim ws As Worksheet
Dim LastCell As Range
Dim rCell As Range
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
Set LastCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(, 7)
'Convert format to 'Text'
.Range(.Cells(1, 8), LastCell).NumberFormat = "#"
End With
End Sub
This way will copy the range to an array and add a ' to each value before posting back to the sheet:
Sub ConvertToString()
Dim ws As Worksheet
Dim LastCell As Range
Dim vValues() As Variant
Dim R As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
'Your code is looking for last cell in column A, so offset to column H once found.
'This is a reference to the last cell, not the row number so can be used in the range.
Set LastCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(, 7)
vValues = .Range(.Cells(1, 8), LastCell).Value
'Add a ' to each value.
For R = 1 To UBound(vValues, 1)
vValues(R, 1) = "'" & vValues(R, 1)
Next R
'Paste back to sheet.
.Range(.Cells(1, 8), LastCell) = vValues
End With
End Sub
Further reading on arrays & worksheets