Set r = Worksheets("Sheet1").Columns("A").Find(What:=" ")
If r Is Nothing Then
MsgBox "done"
\
End If
End Sub
the below code removes any spaces in the text in col A. Hope this is what you were looking for. Amend the code as necessary.
I have done the changes so that it works for the entire sheet. accept the answer by clicking accept if it resolves your requirement
Sub teste()
Dim UsedRng As Range
Dim FirstRow As Long, LastRow As Long, FirstCol As Long, LastCol As Long
Set UsedRng = ActiveSheet.UsedRange
FRow = UsedRng(1).Row
FCol = UsedRng(1).Column
lRow = UsedRng(UsedRng.Cells.Count).Row
Lcol = UsedRng(UsedRng.Cells.Count).Column
For X = FRow To lRow
For Y = FCol To Lcol
temp = Cells(X, Y).Value
tempC = (Trim(temp))
Cells(X, Y).Value = tempC
Next Y
Next X
End Sub
Related
Hello I am trying to copy a range into a single column. The range is a mix of blank cells and cells with values.I only want to copy and paste the cells with values and I would it to find the first blank cell and want it to walk itself down the column from there.
The code I have right now (besides taking forever) pastes in the first row.
Dim i As Integer
i = 1
ThisWorkbook.Worksheets("amount date").Select
For Row = 51 To 100
For col = 2 To 1000
If Cells(Row, col).Value <> "" Then
Cells(Row, col).Copy
Worksheets("sheet 2").Range("G" & i).PasteSpecial xlPasteValues
End If
Next
Next
Do While Worksheets("sheet 2").Range("G" & i).Value <> ""
i = i + 1
Loop
End Sub
This will work:
Sub qwerty()
Dim i As Long, r As Long, c As Long
i = 1
ThisWorkbook.Worksheets("amount date").Select
For r = 51 To 100
For c = 2 To 1000
If Cells(r, c).Value <> "" Then
Cells(r, c).Copy
Worksheets("sheet 2").Range("G" & i).PasteSpecial xlPasteValues
i = i + 1
End If
Next
Next
End Sub
Perhaps this will be a little faster (even though it seems to have been slow arriving).
Sub CopyRangeToSingleColumn()
' 20 Oct 2017
Dim LastRow As Long
Dim LastClm As Long
Dim Rng As Range, Cell As Range
Dim CellVal As Variant
Dim Spike(), i As Long
With ThisWorkbook.Worksheets("amount date")
With .UsedRange.Cells(.UsedRange.Cells.Count)
LastRow = Application.Max(Application.Min(.Row, 100), 51)
LastClm = .Column
End With
Set Rng = .Range(.Cells(51, "A"), .Cells(LastRow, LastClm))
End With
ReDim Spike(Rng.Cells.Count)
For Each Cell In Rng
CellVal = Trim(Cell.Value) ' try to access the sheet less often
If CellVal <> "" Then
Spike(i) = CellVal
i = i + 1
End If
Next Cell
If i Then
ReDim Preserve Spike(i)
With Worksheets("sheet 2")
LastRow = Application.Max(.Cells(.Rows.Count, "G").End(xlUp).Row, 2)
.Cells(LastRow, "G").Resize(UBound(Spike)).Value = Application.Transpose(Spike)
End With
End If
End Sub
The above code was modified to append the result to column G instead of over-writing existing cell values.
Do you need copy the whole row into one cell, row by row? For each loop shall be faster. I guess, this should work
Sub RowToCell()
Dim rng As Range
Dim rRow As Range
Dim rRowNB As Range
Dim cl As Range
Dim sVal As String
Set rng = Worksheets("Sheet3").Range("$B$51:$ALN$100") 'check this range
For Each rRow In rng.Rows
On Error Resume Next
Set rRowNB = rRow.SpecialCells(xlCellTypeConstants)
Set rRowNB = Union(rRow.SpecialCells(xlCellTypeFormulas), rRow)
On Error GoTo 0
For Each cl In rRowNB.Cells
sVal = sVal & cl.Value
Next cl
Worksheets("sheet4").Range("G" & rRow.Row - 50).Value = sVal
sVal = ""
Next rRow
End Sub
its quick for this range.
I am trying to split data into multiple worksheets but when I run my codes, it seems like it has lost its format. The list contains parent codes of the products I am based on splitting.
Product code has 0000-00-00 format and parent code is the first 4 digits, 0000. i.e. 0008-99-99 as product code and 0008 as parent code.
So in my result page, I m getting 8 as result not 0008, and that is why I can't get any product details in them. I tried to use left function and it is still giving me 8 not 0008 for instance. I need help with Sheets(n).Range("A1") = ws3.Cells(i, 1).Text this line of code. When I run my codes, no error just not populating results.
Option Explicit
Sub monthly()
Dim y1 As Workbook
Dim ws1, ws2, ws3 As Worksheet
Dim LR1, LR2, LR3, last As Long
Dim o, r, p As Long
Set y1 = Workbooks("Monthly Template.xlsm")
Set ws2 = y1.Sheets("Products")
Set ws3 = y1.Sheets("List")
LR2 = ws3.Cells(Rows.Count, "A").End(xlUp).Row
ws3.Activate
With ws3
Range("A1:A32").Sort key1:=Range("A1"), Order1:=xlAscending
End With
LR1 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
For o = 3 To LR1
ws2.Cells(o, 29).FormulaR1C1 = "=LEFT(RC[-21],4)"
Next o
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As String
With Sheets("List")
j = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With Sheets("Products")
l = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
For i = 1 To j
n = Sheets("List").Cells(i, 1).Text
Sheets.Add(After:=Sheets(Sheets.Count)).Name = n
Sheets(n).Range("A1") = ws3.Cells(i, 1).Text
For k = 3 To l
With Sheets(n)
If Sheets(n).Cells(1, 1).Value = Sheets("Products").Cells(k, 29).Value Then
m = .Cells(.Rows.Count, 1).End(xlUp).Row
.Rows(m + 1).Value = Sheets("Products").Rows(k).Value
End If
End With
Next k
Next i
End Sub
The idea behind this is to use vba vlookup on column G:AI from sheet11-13 to sheet1. Header ends at row 3 across all worksheets.
I have written the codes as below. The code stops at the ws1.Cells(r, c).Value = Application.WorksheetFunction.VLookup(ws1.Cells(r, 1).Value, ws2.Range("A1:AI500"), colnum, False) showing subset out of range and sometimes even
Run-time error '1004': Unable to get the VLookup property of the WorksheetFunction class.
Please advice on the way forward.
I Would like to send out files for better clarification but can't seem to find the attach function. Thank you !
Sub green_update()
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Set wb = ThisWorkbook
Set ws1 = wb.Sheets("Sheet1")
Set ws2 = wb.Sheets("Sheet13")
Dim bil As String
Dim lastrow As Long
Dim for_col As Long, i As Long, r As Long, c As Long, colnum As Long
r = 4: c = 7: colnum = 7
'mysheets = "sheet11:sheet12:sheet13"
'i would like to allow vlookup to search through all sheet 11-13
For for_col = 1 To ws2.Cells("4", Columns.Count).End(xlToLeft).column
lastrow = ws2.Cells(Rows.Count, "A").End(xlUp).row
For i = 1 To lastrow - 3
ws1.Cells(r, c).Value = Application.WorksheetFunction.VLookup(ws1.Cells(r, 1).Value, ws2.Range("A1:AI500"), colnum, False)
r = r + 1
Next
r = 4
colnum = colnum + 1
c = c + 1
Next
End Sub
As you have totally changed what you were asking.. I am posting another answer to make it clear.
Still your request is not totally clear so that some inputs may refer to wrong destinations but you can change those ones easily.
If you don't understand any part feel free to ask it again.
Option Explicit
Sub green_update()
Application.ScreenUpdating = False
Dim zaman As Double
zaman = Timer
Dim wb As Workbook, ws1 As Worksheet, wsNames as Worksheet
Set wb = ThisWorkbook
Set ws1 = wb.Sheets("Sheet1")
Dim colNo As Long, OthARowNo As Long, sh1ARowNo As Long
Dim for_col As Long, i As Long, r As Long, c As Long, colnum As Long
r = 4: c = 7: colnum = 7
For Each wsNames In Sheets(Array("sheet11", "sheet12", "sheet13"))
colNo = wsNames.Cells("4", Columns.Count).End(xlToLeft).column
'Column numbers are 35 but you are working between G:AI which is 29 columns!
OthARowNo = wsNames.Cells(Rows.Count, "A").End(xlUp).row
sh1ARowNo = ws1.Cells(Rows.Count, "A").End(xlUp).row
For for_col = 7 To colNo 'colNo Is 35 Green columns start at 7th column, totally 29 loop, till 35th one.
For i = 1 To sh1ARowNo 'This should run until sh1's row number
ws1.Cells(r, c).Value = Application.VLookup(ws1.Cells(r, 1).Value, wsNames.Range("A1:AI" & OthARowNo), colnum, False)
If IsError(ws1.Cells(r, c).Value) Then
ws1.Cells(r, c).Value = ""
End If
r = r + 1
Next i
r = 4
colnum = colnum + 1
c = c + 1
Next for_col
colnum = 7
c = c + 6 'There are 6 columns between AI:AP and BR:BY
Next wsNames
Application.ScreenUpdating = True
MsgBox Format(Timer - zaman, "00.00") & "secs"
End Sub
I explained my answer within the code, but to summarize your problems:
1- You don't define your variables, especially worksheets. Never Assume your worksheet and always define and set references to Workbooks and Worksheets
2- You are limiting your For loops with the Row number of A column and Column number of 3rd row, but what if they are empty or not compatible with your lookup rounds? Then you may get error or wrong results. Define them carefully.
Option Explicit
Sub green_update()
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Set wb = ThisWorkbook
Set ws1 = wb.Sheets("Sheet1") 'Change this Sheet1 name with your current Worksheet name
Set ws2 = wb.Sheets("mysheets")
Dim bil As String 'I don't know where do you use that variable.
Dim lastrow As Long 'Prefer to work with Long instead of Integer
Dim for_col As Long, i As Long, r As Long, c As Long, colnum As Long
r = 4: c = 7: colnum = 7
For for_col = 1 To ws2.Cells("4", Columns.Count).End(xlToLeft).Column
'This is important! Here in this case are you sure you, _
'you would like to define how many times your For loop will run based on 3rd row?
lastrow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
'This is also important! Are you sure you would like to run your For loop_
'based on the row number of A column? I think you should define it -3 _
'because you start your lookup from D4 (so first 3 one Is not necessary)
For i = 1 To lastrow - 3
ws1.Cells(r, c).Value = WorksheetFunction.VLookup(ws1.Cells(r, 4).Value, ws2.Range("A1:AI500"), colnum, False)
r = r + 1
Next
r = 4
colnum = colnum + 1
c = c + 1
Next
End Sub
I'm trying to import cells from another wb. So if cell in wb1 col H matches cell in wb2 col K then wb1 col k and L = wb2 col C and E in match row. Now there may be several matches so I want it to offset to the next column. m and n for next set, o and p for next, and so on.
This is what I have so far:
Private Sub CommandButton1_Click()
Dim rcell As Range, sValue As String
Dim lcol As Long, cRow As Long
Dim dRange As Range, sCell As Range
Dim LastRow As Integer
Dim CurrentRow As Integer
Set ws1 = ThisWorkbook
Set ws2 = Workbooks("Workbook2").Worksheets("Sheet1")
Sheet1LastRow = ThisWorkbook.Sheets("Data").Range("H2:H50000").Value 'Search criteria column
Sheet2LastRow = Workbooks("Workbook2").Worksheets("Sheet1").Range("Q" & Rows.Count).End(xlUp).Row 'Where to look for matches
With Workbooks("Workbook2").Worksheets("Sheet1")
For j = 1 To Sheet1LastRow
For i = 1 To Sheet2LastRow
If ThisWorkbook.Sheets("Data").Range("H").Value = ws2.Cells(i, 11).Value Then
ws2.Cells(i, 11).Value = ThisWorkbook.Sheets("Data").Range("C").Value
ws2.Cells(i, 12).Value = ThisWorkbook.Sheets("Data").Range("E").Value
End If
If InStr(1, ws2.Cells.Value, ws1.Cells.Value) And Trim(ws1.Cells.Value) <> "" Then
rcell.Offset(0, lcol).Value = ws2.Cells.Offset(0, 2).Value
lcol = lcol + 1
End If
Next i
Next j
End With
End Sub
This doesn't work. I basically gave up since I don't know what I'm missing.
I looked for something like this but only found something a Vlookup or Match could do.
You can do it by keeping track of an offset that you shift by two after each match copied. I'll track this in a variable called offs.
Also I suppose that the copying goes from wb2 to wb1 as described in the text, not as "suspected" in the code.
Private Sub CommandButton1_Click()
Dim cel1 As Range, cel2 As Range
For Each cel1 In ThisWorkbook.Sheets("Data").UsedRange.Columns("H").Cells
Dim offs As Long: offs = 3 ' <-- Initial offset, will increase by 2 after each match
For Each cel2 In Workbooks("Workbook2").Worksheets("Sheet1").UsedRange.Columns("K").Cells
If cel1.Value = cel2.Value Then
cel1.offset(, offs).Value = cel2.offset(, -8).Value ' <- wb2(C) to wb1(K)
cel1.offset(, offs + 1).Value = cel2.offset(, -6).Value ' <- wb2(E) to wb1(L)
offs = offs + 2 ' <-- now shift the destination column by 2 for next match
End If
Next
Next
End Sub
I have a loop towards the bottom of my code that successfully loops through my data and clears out all rows where Column H = 0.
However, there are several cells in column B displaying #REF!. I would also like this loop to delete those rows in the same manner as it does the 0s in column H.
I think my issue is not knowing how to reference those types of errors. Treating #REF! like a string doesn't appear to be working.
Thank you!
Sub test()
Dim currentSht As Worksheet
Dim lastRow As Long
Dim lastCol As Long
Dim startCell As Range
Dim r As Integer
Set startCell = Sheets("Sheet1").Range("A1")
Set currentSht = ActiveWorkbook.Sheets("Sheet1")
lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row '<~~ Not sure why, but do not use "Set" when defining lastRow
lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column
For r = 1 To lastRow Step -1
If currentSht.Cells(r, "H").Value = 0 Or currentSht.Cells(r, "B").Text = "#REF!" Then
Rows(r).Select
Selection.EntireRow.Delete
End If
Next r
currentSht.Range(startCell, currentSht.Cells(lastRow, lastCol)).Select
End Sub
I think I see your problem:
For r = 1 To lastRow Step -1
Change that line to
For r = lastrow to 1 Step -1
How about this code:
Sub Delete0()
Dim F As Integer
Dim Y As Integer
Dim RngCount As Range
Set RngCount = ActiveSheet.Range("H:H")
Y = Application.WorksheetFunction.CountA(RngCount)
For F = Y To 1 Step -1
If IsError(ActiveSheet.Range("H" & F)) Then
ActiveSheet.Rows(F).EntireRow.Delete
ElseIf ActiveSheet.Range("H" & F).Value = 0 Then
ActiveSheet.Rows(F).EntireRow.Delete
End If
Next F
End Sub