I am very new to VBA, so this probably has a very simple answer!
I am trying to use the Left function to produce a string of the first digit of the cells in a column, but for reasons which I don't understand, when I use Range.Value = Left(...) it does not put the values that I have got from Left(...) into the cell.
I am left with a blank column A when the code has finished running.
Can anyone explain why this is happening and suggest how to fix it.
The code I wrote is:
Dim r As Integer
Dim var As Variant
r = Range("B1").CurrentRegion.Rows.Count
For var = 2 To r
Range("A" & var).Value = Left(Cells(var, 1).Text, 1)
Next var
Thanks so much.
Most probably you are not declaring something completely - either the worksheet, or the rows in the current region. Start with something as simple as this one to see how it works:
Public Sub HereComesTheCode()
Dim r As Long: r = 10
Dim i As Long
Dim wks As Worksheet: Set wks = Worksheets(1)
For i = 2 To r
With wks
.Range("A" & i) = Left(.Cells(i, 1), 1)
End With
Next
End Sub
This would be an alternative method, scanning the cells in B and writing the first letter of each cell into the cell to the left of it:
Dim c As Range
For Each c In Range("B1", "B" & Cells(Rows.Count, "B").End(xlUp).Row).Cells
c.Offset(0, -1).Value = Left(c.Text, 1)
Next
Note: Strictly speaking, it would be good practice to qualify your ranges though:
Dim c As Range
With Worksheets("YOUR_SHEET_NAME_HERE")
For Each c In .Range("B1", "B" & .Cells(.Rows.Count, "B").End(xlUp).Row).Cells
c.Offset(0, -1).Value = Left(c.Text, 1)
Next
End With
Related
Trying to figure out what the code below is doing, but cannot figure it out:
For Each c In Sheets("Control").Range("y3:y" & Range("y" &
Rows.Count).End(xlUp).Row).Cells
Sheets("forecast").Range("a5") = c
What I think is happening:
Below c is set to a certain cell, this contains a name. In the upper part for every cell, in sheet control, for the range from y3 till the end, .... and then the confusion starts. What happens next:
Range(".." & Range(".." & Rows.Count).End(x1Up).Row).Cells
How do I read this?
This is the table from Sheets("Control"):
Range(".." & Rows.Count).End(x1Up).Row - you have a typo here, it is xlUp (l, for lemonade, instead of 1). Use Option Explicit to avoid such mistakes!
Anyhow, it means something like that: in column "..", in your case y, go to the very last row at the bottom. Then go up, until first non-blank cell is met and get its Row.
So if you have values in range Y1:Y20, then going up from the bottom will end in 20th row, giving you 20 as the row number.
There are two ways. You can do this by importing it as a range object or by saving it as an array.
First: as Range
Sub test()
Dim Ws As Worksheet
Dim rngDB As Range, c As Range
Set Ws = Sheets("Control")
With Ws
Set rngDB = .Range("y3", "y" & .Range("y" & Rows.Count).End(xlUp).Row)
End With
For Each c In rngDB
Sheets("forecast").Range("a5") = c
Sheets("forecast").Range("b5") = c.Offset(0, 1)
End Sub
Second: as Variant Array
Sub test2()
Dim Ws As Worksheet
Dim rngDB As Range, c As Range
Dim vDB
Dim i As Long
Set Ws = Sheets("Control")
With Ws
Set rngDB = .Range("y3", "z" & .Range("y" & Rows.Count).End(xlUp).Row)
vDB = rngDB '<~~ get data from rngdb to array vDB
End With
For i = 1 To UBound(vDB, 1)
Sheets("forecast").Range("a" & i + 4) = vDB(i, 1)
Sheets("forecast").Range("b" & i + 4) = vDB(i, 2)
End Sub
Sub Add_Leading_Zeros()
Dim LastColumn As Integer
LastColumn = ActiveSheet.Cells(Columns.Count, 1).End(xlUp).Column
Dim LastRow As Integer
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Dim HeaderRange As Range, HeaderCell As Range
Set HeaderRange = Range("A1:A" & LastColumn)
For Each HeaderCell In HeaderRange
If InStr(1, HeaderCell.Value, "Title") > 0 Or InStr(1, HeaderCell.Value, "title") > 0 Then
Dim TitleRange As Range, TitleCell As Range
Set TitleRange = 'range of that cell's used cells in that column
'Add Zeroes to front of number until total numbers = 4
End Sub
Above is a rough outline of what I'm aiming for. I want to have my macro scan a row and if any cells in that row match a word then I want to add 0's to the front of each cell in that column until each cell has a total of 4 numbers. Essentially adding leading zeros.
Am I on the right track? What can I do to look up solutions or learn? I would like help writing this code but I also want to understand the thought process behind the decisions so I can continue my learning.
Sub Add_Leading_Zeros()
Dim sht As Worksheet
Dim HeaderRange As Range, HeaderCell As Range, c As Range
Set sht = ActiveSheet
For Each HeaderCell In sht.Range(sht.Range("A1"), sht.Cells(1, Columns.Count).End(xlToLeft)).Cells
If LCase(HeaderCell) Like "*title*" Then
For Each c In sht.Range(HeaderCell.Offset(1, 0), _
sht.Cells(Rows.Count, HeaderCell.Column).End(xlUp)).Cells
If Len(c.Value) > 0 Then
c.NumberFormat = "#" 'Text
c.Value = Right("0000" & c.Value, 4)
End If
Next c
End If
Next HeaderCell
End Sub
If you want to add a leading zero to a cell:
cells(i,1).value = "0" & cells(i,1).value
The rest of your approach looks fine, in terms of what you're aiming to do... you've got quite a few issues with syntax, e.g., cells(1,columns.count) versus cells(rows.count,1).
I would say to be careful on the terms you're using to describe. You are looking down a column and different rows, from what I can read in your code, but your post talks about finding items in a row.
If you are going down a column, you can use application.match to help determine if you have anything matching cells above your current cell, similar to:
Dim i As Long, lr As Long
With Sheets(1)
lr = .Cells(Rows.Count, 4).End(xlUp).Row)
For i = 2 To lr
On Error Resume Next
If Application.Match(.Cells(i, 4), .Range(.Cells(1, 1), .Cells(lr, 1)), 0) > lr Then .cells(i,1).value = "0" & .cells(i,1).value
Next i
End With
I have two worksheets in different workbooks. Each sheet can have only a few lines to thousands of lines. They never have the same number of lines.
In Column E of the Capital worksheet, I want to find any and all cells that contain ITS#### where #### are numeric characters. When a cell is identified, I want to go to column A of that row and identify that value. I then want to find the value I just identified (Column A) in column J of the Trans worksheet which is in a different workbook. If a match is found, I want the value of column I in the Trans workbook to be changed to "Cost of Goods Sold/Expense.
I have searched the Internet for weeks and have tried many different solutions to similar problems, but have found nothing that works. I believe I could figure it out if someone could get me past the indicated line. I keep getting a
Run-time error 1004 Method Range of object _worksheet failed.
The following code is one that I was working on, but I was just tying to get past the error so it doesn't even try to tackle the entire problem.
Thank you for any help you may provide.
Sub ITSTRANSCOM()
'
' ITSTRANSCOM Macro
'
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Variant
Dim C As Variant
Dim Lrow As Variant
Dim Lastrow As Variant
Set ws1 = Worksheets("Capital")
Set ws2 = Worksheets("Trans")
Lrow = ws1.Cells(ws1.Rows.Count, "A:A").End(xlUp).Row
Lastrow = ws2.Cells(ws2.Rows.Count, "j:j").End(xlUp).Row
'Run-time error occurs on next row.
For Each i In ws1.Range("A:A", Lrow)
For Each C In ws2.Range("J:J", Lastrow)
If i.Cells.Value = C.Cells.Value Then
If C.Cells.Value = "ITS####" Then
i.Cells.Interior.ColorIndex = xlNone
End If
End If
Next C
Next i
End Sub
Try something like this:
Dim I as Integer, C as Integer
Dim Tmp_Val as Variant
For I = 1 to LRow
If Left(UCase(Ws1.Range(“E” & I).Value),3) = “ITS” then
Tmp_Val = Ws1.Range(“A” & I).Value
For C = 1 to LastRow
If Ws2.Range(“J” & C).Value = Tmp_Val then
Ws2.Range(“I” & C).Value = “Cost of Goods Sold/Expense”
Exit For
End if
Next C
End if
Next I
Your solution looks like it is on the way there...just try replacing the line:
If C.Cells.Value = "ITS####" Then
With the line:
If UCase(Left(C.Cells.Value,3)) = "ITS" Then
I think that will allow you to identify the cells you want, and you seem like you should be capable of developing the code to shift those values between your sheets (based on your other code).
Try changing
For Each i In ws1.Range("A:A", Lrow)
to
For Each i In ws1.Range("A1", "A" & Lrow)
Same with For Each C In ws2.Range("J:J", Lastrow):
For Each C In ws2.Range("J1", "J" & Lastrow)
Looks simple. Perhaps I did not get your explanations right ?
Dim c As Range, r As Range
For Each c In ws1.Range("A:A").SpecialCells(xlCellTypeConstants, xlTextValues).Cells
If c.Value Like "ITS[0-9][0-9][0-9][0-9]" Then
Set r = ws2.Range("J:J").Find(c.Value)
If Not r Is Nothing Then
r.Offset(0, -1) = "Cost of Goods Sold/Expense"
Else
Debug.Print c.Value, " not found"
End If
End If
Next c
Debug.Print "Done"
Working Environment: Excel 2013
Target: Copy C1:C9 to B11:B19. D1:D9 to B21:B29. E1:E9 to B31:B39.....
After copying all the range to column B, copy A1:A9 to A11:A19(A21:A29....)
My idea is that:
1. select a range by using something like
range.end()
because in some of my sheets, there are only 4 test steps. so I need a syntax which can self inspect the used cells in a column.
do a range copy to column B.
leave 1 row in between considering about the page layout.
My piece of code is:
Worksheets("Master").Columns(3).UsedRange.Copy
Worksheets("Master").Range("B11").PasteSpecial
but seems like the Columns(i).UsedRange.Copy doesn't work. the pastespecial works.
My question is：
How to select the used range in columns? The number of columns are not fixed which means some of the sheets have 40 columns, but some of the other have maybe 30.
Thanks!
I attached one screenshot of the sheet for your reference.
Assuming you do not have more data in the columns to be copied, this should work
Sub copyToOneColumn()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Master")
Dim startCol As Integer
startCol = 3
Dim endCol As Integer
endCol = 10
Dim startRange As Range
Dim ra As Range
For i = startCol To endCol
Set startRange = ws.Range("A1").Offset(0, i - 1)
Set ra = ws.Range(startRange, ws.Cells(Rows.Count, startRange.Column).End(xlUp))
ra.Copy Destination:=ws.Range("B" & Rows.Count).End(xlUp).Offset(2, 0)
Next i
End Sub
You can do a copy (not technically a copy as it doesn't use the clipboard) directly like so:
Range("B1").Resize(Range("A1:A" & range("A" & Rows.Count).End(xlUp).Row).Rows.Count,1) = Range("A1:A" & range("A" & Rows.Count).End(xlUp).Row).Value
Effectively you are looking at B1 then resizing that to a range to be the number of columns in column A that are used with this: Range("A1:A" & range("A" & Rows.Count).End(xlUp).Row).Rows.Count
Then you are making this new range in column B = to the values of the same range in column A.
Note, this can be shortened if you are always starting at row 1 but the code I have given you will suffice if you start at a different row.
You may try something like this...
Sub CopyData()
Dim wsMaster As Worksheet
Dim lr As Long, lc As Long, r As Long, c As Long
Application.ScreenUpdating = False
Set wsMaster = Sheets("Master")
lr = wsMaster.Cells(Rows.Count, 1).End(xlUp).Row
lc = wsMaster.Cells(1, Columns.Count).End(xlToLeft).Column
r = lr + 2
If lr <= 9 Then
For c = 3 To lc
wsMaster.Range(wsMaster.Cells(1, c), wsMaster.Cells(lr, c)).Copy wsMaster.Range("B" & r)
wsMaster.Range("A1:A" & lr).Copy wsMaster.Range("A" & r)
r = wsMaster.Cells(Rows.Count, 2).End(xlUp).Row + 2
Next c
End If
Application.ScreenUpdating = True
End Sub
I have two columns which I am comparing for identical entries, and pushing the matches to another column through Offset. When I run the macro I've built (off of some Microsoft canned code) it essentially freezes and crashes, since it is a nested for each loop based on cells that are used, I figured it would end upon reaching an empty cell, but I fear I may be in a infinite loop. Any help will be much appreciated.
Dim myRng As Range
Dim lastCell As Long
Dim lastRow As Long
lastRow = ActiveSheet.UsedRange.Rows.Count
Dim c As Range
Dim d As Range
For Each c In Worksheets("Sheet1").Range("AT2:AT" & lastRow).Cells
For Each d In Worksheets("Sheet1").Range("AU2:AU" & lastRow).Cells
If c = d Then c.Offset(0, 1) = c
Next d
Next c
Try this:
Dim lastRow, currentRow, compareRow As Long
Dim found As Boolean
lastRow = Range("AT2").End(xlDown).Row
For currentRow = 2 To lastRow
compareRow = 2
found = False
Do While compareRow <= lastRow And Not found
If Range("AT" & currentRow).Value = Range("AU" & compareRow).Value Then
found = True
Range("AV" & currentRow).Value = Range("AT" & currentRow).Value
End If
compareRow = compareRow + 1
DoEvents
Loop
Next currentRow
Rather than selecting ranges and then cycling through them, this does the same thing without needing to .Select anything. It also breaks out of the inner loop early if it finds a match.
I believe that there are multiple issues here:
Efficiency of the search method
Loss of responsiveness of Excel
You can dramatically improve the efficiency of the code if you can pull all values into arrays. This prevents the time spent by VBA in accessing the Excel Object model and back. Loss of responsiveness can be handled by using DoEvents. Try the code below. It may look longish but should be easy to understand.
'Find last row
Dim lastRow As Variant
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
'Create dynamic arrays
Dim AT() As Variant: Dim AU() As Variant: Dim AV() As Variant
ReDim AT(2 To lastRow): ReDim AU(2 To lastRow): ReDim AV(2 To lastRow)
'Get all contents from Excel
For i = 2 To lastRow
AT(i) = Worksheets("Sheet1").Cells(i, 46)
AU(i) = Worksheets("Sheet1").Cells(i, 47)
Next i
'Do the comparison
For c = 2 To lastRow
For d = 2 To lastRow
If AT(c) = AU(d) Then AV(c) = AT(c)
Next d
'Allow a brief breather to Excel once in a while (don't hang)
If (c / 100) = Int(c / 100) Then DoEvents
Next c
'Place final contents to Excel
For i = 2 To lastRow
Worksheets("Sheet1").Cells(i, 48) = AV(i)
Next i
Try this for your loop:
Dim StartRange As Range, j As Long
Dim CompareRange As Range, i As Range
With Worksheets("Sheet1")
Set StartRange = .Range("AT1", .Range("AT:AT").Find("*", , , , xlByRows, xlPrevious))
Set CompareRange = .Range("AU1", .Range("AU:AU").Find("*", , , , xlByRows, xlPrevious))
For Each i In StartRange
i.Offset(, -8).Value = .Evaluate("IF(COUNTIF(" & CompareRange.Address(0, 0) & "," & i.Address(0, 0) & ")>0," & i.Value & ","""")")
Next i
End With
Dim CompareRange As Variant, To_Be_Compared As Variant, j As Variant, k As Variant
Range("AT2").Select
Selection.End(xlDown).Select
Set To_Be_Compared = Range("AT2:" & Selection.Address)
Range("AU2").Select
Selection.End(xlDown).Select
Set CompareRange = Range("AU2:" & Selection.Address)
To_Be_Compared.Select
For Each j In Selection
DoEvents
For Each k In CompareRange
If j = k Then j.Offset(0, 2) = j
Next k
Next j
I finally got it to work, after taking the suggestions and implementing them into my code, I was able to see where the mistake actually was, I was referencing the wrong column earlier in the code and through this, created no duplicate entries to match, so after fixing this, the matches now appear, I ended up offsetting them, and changing the value to "yes" to reflect the duplication in my chart.
Thank you all for the help.