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
Related
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
I am working on building code which can loop through a column (B5:B) on multiple worksheets to find matching values. If the Value on one worksheet's column (B5:B) is equal to a worksheet name, then the worksheet name is placed on the adjacent column (C5:C) to where the value was found. I am not a programmer, but I've been learning VBA to make this happen. So far I have tried unsuccessfully to use the For Next Loop (starting with the 3rd sheet), the For Each ws in Thisworkbook.sheets method. But I don't seem to be able to make it work. I've searched all over the internet for something similar, but no dice. Any suggestions would be greatly appreciated.
Sub MatchingPeople()
Dim c As Variant
Dim lastrow As Long
Dim i As Variant
Dim g As Long
Dim w As Long
i = Sheets("Anthony").Name
g = Sheets("Anthony").Cells(Rows.Count, "C").End(xlUp).Row
For w = 3 To Sheets.Count
lastrow = Sheets(w).Cells(Rows.Count, 2).End(xlUp).Row
Set NewRang = Sheets("Anthony").Cells(g + 1, 3)
On Error Resume Next
With Sheets(w).Range(Cells(5, 2), Cells(lasty, 2))
Set c = .Find(i, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
NewRang.Value = Sheets(w).Name
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
Next w
End Sub
Here are 2 versions, one using the Find method like in your code, the other using a For loop
Option Explicit
Public Sub MatchingPeopleFind()
Dim i As Long, lrColB As Long
Dim wsCount As Long, wsName As String
Dim found As Variant, foundAdr As String
wsCount = Worksheets.Count
If wsCount >= 3 Then
For i = 3 To wsCount
With Worksheets(i)
wsName = .Name
lrColB = .Cells(.Rows.Count, 2).End(xlUp).Row
With .Range(.Cells(5, 2), .Cells(lrColB, 2))
Set found = .Find(wsName, LookIn:=xlValues)
If Not found Is Nothing Then
foundAdr = found.Address
Do
found.Offset(0, 1).Value2 = wsName
Set found = .FindNext(found)
Loop While Not found Is Nothing And found.Address <> foundAdr
End If
End With
End With
Next
End If
End Sub
Public Sub MatchingPeopleForLoop()
Dim wsCount As Long, wsName As String, i As Long, j As Long
wsCount = Worksheets.Count
If wsCount >= 3 Then
For i = 3 To wsCount
With Worksheets(i)
wsName = .Name
For j = 5 To .Cells(.Rows.Count, 2).End(xlUp).Row
If .Cells(j, 2).Value2 = wsName Then .Cells(j, 3).Value2 = wsName
Next
End With
Next
End If
End Sub
Sub Bygone()
Dim x As Long
Dim y As Long
Dim z As Long
Dim w As Long
Dim a As Long
Dim b As Long
Dim c As Long
Dim m As Long
a = Sheets.Count
For m = 3 To a
x = Sheets(m).Cells(3, 3).Value
For b = 3 To a
w = Sheets(b).Cells(Rows.Count, 1).End(xlUp).row
For z = 5 To w
y = Sheets(b).Cells(z, 1)
Select Case x
Case y
c =Sheets(m).Cells(Rows.Count,3).End(xlUp).Offset(1, 0).row
Sheets(m).Cells(c, 3).Value = Sheets(b).Name
End Select
Next z
Next b
Next m
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 need help with this small project. What I need to accomplished this task is the following:
I have a excel file where my macro button once clicked will read the data from a sheet1 only in column A then should throw the data to another sheet2 and move every data from the sheet1 to sheet2 and display all the data to each separate column.
here is a image of the data example. in the image every circle needs to be in its own column to the new sheet2 that is only part of the data the total of the column rows is around 900.
if need more information please let me know.
here is the code I have it copy the sheet from sheet1 to sheet2 but I need the rest to work
Sub ExportFile()
Dim strValue As String
Dim strCellNum As String
Dim x As String
x = 1
For i = 1 To 700 Step 7
strCellNum = "A" & i
strValue = Worksheets("data").Range(strCellNum).Value
Debug.Print strValue
Worksheets("NewData").Range("A" & x).Value = strValue
x = x + 1
Next
End Sub
Give this a try:
Sub DataReorganizer()
Dim s1 As Worksheet, s2 As Worksheet, N As Long, i As Long, j As Long, k As Long
Dim v As Variant
Set s1 = Sheets("Data")
Set s2 = Sheets("NewData")
N = s1.Cells(Rows.Count, "A").End(xlUp).Row
For i = N To 2 Step -1
If s1.Cells(i, "A").Value = "" And s1.Cells(i - 1, "A").Value = "" Then s1.Cells(i, "A").Delete shift:=xlUp
Next i
j = 1
k = 1
N = s1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To N
v = s1.Cells(i, "A").Value
If v = "" Then
j = 1
k = k + 1
Else
s2.Cells(j, k).Value = v
j = j + 1
End If
Next i
End Sub
you can try this:
Sub ExportFile()
Dim area As Range
Dim icol As Long
With Worksheets("data")
With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants)
For Each area In .Areas
icol = icol + 1
Worksheets("NewData").Cells(1, icol).Resize(area.Rows.Count).Value = area.Value
Next
End With
End With
End Sub
I have a piece of VB code in excel to hide columns with less than 2 data entries (header as a minimum) and I need to know how to use this to hide columns whilst ignoring information in filtered out rows:
Sub HideCols()
Dim LC As Integer, j As Integer
Dim cl As Range, rng As Range
Set rng = Range("Table1").SpecialCells(xlCellTypeVisible)
LC = Cells(3, Columns.Count).End(xlToLeft).Column
For j = 3 To LC
Columns(j).Hidden = WorksheetFunction.CountA(Columns(j)) < 2
Next j
Application.ScreenUpdating = True
End Sub
This is what I have, a lot of it makes no sense and needs tidying up but that's only as I've been trying to find my own way to no avail.
Thanks!
I'd go like follows
Option Explicit
Sub HideCols()
Dim cols As Range
Dim iCol As Long
With Range("Table1")
Set cols = .Resize(1, 1).Offset(, .Columns.Count + 1)
For iCol = 1 To .Columns.Count
If Application.WorksheetFunction.Subtotal(103, .Columns(iCol).SpecialCells(xlCellTypeVisible)) < 2 Then Set cols = Union(cols, .Cells(1, iCol))
Next iCol
Set cols = Intersect(.Columns, cols)
If Not cols Is Nothing Then cols.EntireColumn.Hidden = True
End With
End Sub
as a side note, if filtering is done out of Autofilter() method then also header rows are not filtered out. in this case you may want to change the right term of If check to < 3
Check if it's hidden first
Sub HideCols()
Dim LC As Integer, j As Integer
Dim LR As Integer, curCnt as Integer
Dim cl As Range, rng As Range
Dim Data As Variant
Set rng = Range("Table1").SpecialCells(xlCellTypeVisible)
LC = Cells(3, Columns.Count).End(xlToLeft).Column
For j = 3 To LC
LR = Cells(Rows.Count, j).End(xlUp).Row
curCnt = 0
' its faster to iterate a variant array than it is Cells
Data = Range( Cells(1, 1), Cells(LR, LC) )
for k = 1 to LR
if Rows(k).Hidden = False and Data(k, j) <> "" Then _
curCnt = curCnt + 1
next k
Columns(j).Hidden = curCnt < 2
Next j
Application.ScreenUpdating = True
End Sub