i have a array "v" in sheet 3 and i need to copy the last column of it to sheet one using a loop.it is only working if i am on sheet 3. i want it to work regardless of what sheet i am on. In this loop i have
For i = 1 To Cells(12, 8).Value 'this cell is in sheet 2
'i need this Cells(7, i + 8).Value output to be in sheet 1
Cells(7, i + 8).Value = v(i, UBound(v, 1))
Next i
' for the array
With Worksheets("three")
Const firstCol As Long = 7, firstRow As Long = 12
lastCol = Sheet3.Cells(firstRow, Columns.Count).End(xlToLeft).Column
lastRow = Sheet3.Cells(Rows.Count, lastCol).End(xlUp).Row
v= Range(Cells(firstRow, firstCol), Cells(lastRow, lastCol))
End With
braX
This should get it done:
Dim Src as Worksheet
Dim Dst as Worksheet
Set Dst = Worksheets("One") 'I assume this isn't the real name?
Set Src = Worksheets("Three") 'I assume this isn't the real name?
'You'll progablly want to dim/set this sheet also but I don't know what to call it
For i = 1 To Worksheets("Sheet2").Cells(12, 8).Value 'this cell is in sheet 2
'i need this Cells(7, i + 8).Value output to be in sheet 1
Dst.Cells(7, i + 8).Value = v(i, UBound(v, 1))
Next i
' for the array
With Src
Const firstCol As Long = 7, firstRow As Long = 12
lastCol = .Cells(firstRow, Columns.Count).End(xlToLeft).Column
lastRow = .Cells(Rows.Count, lastCol).End(xlUp).Row
'*** Don't know which sheet formula below is looking at but you get the gist
v= Range(Cells(firstRow, firstCol), Cells(lastRow, lastCol))
End With 'Src
HTH
Related
I have a table of headers and Row is a list of values. I'm trying to concatenate the whole table so the header is followed by the value in row A like this -
Correct
I have a loop that does this quite nicely however it has begun to take some time to work -
r = 2
c = 2
Do While Cells(1, r) <> ""
Do While Cells(c, 1) <> ""
Cells(c, r) = Cells(1, r) & Cells(c, 1)
c = c + 1
Loop
r = r + 1
c = 2
Loop
I've tried to use a formula instead -
Dim lngLastRow As Long
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("B2:B" & lngLastRow).Formula = "=B1 & ""_"" & A2"
But I get the following - Error
Any help would be much appreciated.
You don't need a nested loop in the code. (Unless you plan to use more columns and want to quickly expand that out without modding the code.)
Dim i As Long
Dim lr As Long
With Sheets("Sheet1")
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
.Cells(i, 2).Value = .Cells(1, 2).Value & .Cells(i, 1).Value
.Cells(i, 3).Value = .Cells(1, 3).Value & .Cells(i, 1).Value
.Cells(i, 4).Value = .Cells(1, 4).Value & .Cells(i, 1).Value
Next i
End With
With dynamic columns:
Dim i As Long
Dim j As Long
Dim lr As Long
Dim lc As Long
With Sheets("Sheet1")
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
For i = 2 To lr
For j = 2 To lc
.Cells(i, j).Value = .Cells(1, j).Value & .Cells(i, 1).Value
Next j
Next i
End With
For your formula you need to set row for the access level and column for name to be absolute:
=CONCATENATE(B$1,$A2)
This will allow you to drag the formula around without messing up what it's grabbing
I want to change the way data is shown on an excel sheet. Here are the images that describe how it looks currently
But I want to include one row per B code columns something like this:
Tried transposing etc but it did not work
Can someone help me please?
You could use this:
Option Explicit
Sub run()
Dim LastColumn As Long, LastRow As Long, LastRow2 As Long, i As Long, j As Long
Dim ServiceName As String, Route As String, B_Code As String
Dim sDate As Date
Dim Code_Value As Double
'Change sheet if needed
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
For i = 2 To LastRow
ServiceName = .Cells(i, 1).Value
sDate = .Cells(i, 2).Value
Route = .Cells(i, 3).Value
For j = 4 To LastColumn
B_Code = .Cells(1, j).Value
Code_Value = .Cells(i, j).Value
With ThisWorkbook.Worksheets("Sheet2")
LastRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(LastRow2 + 1, 1).Value = sDate
.Cells(LastRow2 + 1, 2).Value = ServiceName
.Cells(LastRow2 + 1, 3).Value = Route
.Cells(LastRow2 + 1, 4).Value = B_Code
.Cells(LastRow2 + 1, 5).Value = Code_Value
End With
Next j
Next i
End With
End Sub
The results as paste in Sheet2
I have 2 tables in different worksheets and i have to do vlookup to get the data from both these dynamic tables. I have done this using a for loop but sue to large data, excel is crashing. Is there any other way to do this?
The columns in the lookup array will be constant. But the rows will keep on changing.
Sheets("HRG").Activate
lastrow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
lastcolumn = ActiveSheet.UsedRange.Column +
ActiveSheet.UsedRange.Columns.Count - 1
Set VLRange = ActiveSheet.Range(Cells(2, 1), Cells(lastrow, lastcolumn))
Sheets("HRA").Activate
With ActiveSheet
lastrowHRA = .Range("A" & .Rows.Count).End(xlUp).Row
End With
For i = 2 To lastrowHRA
ActiveSheet.Cells(i, lastColHRA + 1) = Application.VLookup(ActiveSheet.Cells(i, 1), VLRange, 11, False)
ActiveSheet.Cells(i, lastColHRA + 2) = Application.VLookup(ActiveSheet.Cells(i, 1), VLRange, 53, False)
Next i
For all intents and purposes, VLOOKUP simply looks up a value in one column and returns the value in another column for that row.
Option Explicit
Sub HRG2HRa()
Dim i As Long, j As Long, m As Variant
Dim hrgA As Variant, hrgK As Variant, hrgBA As Variant
Dim hraA As Variant, hra2C As Variant
With Worksheets("HRG")
i = .Cells(.Rows.Count, "A").End(xlUp).Row
hrgA = .Range(.Cells(2, "A"), .Cells(i, "A")).Value2
hrgK = .Range(.Cells(2, "K"), .Cells(i, "K")).Value2
hrgBA = .Range(.Cells(2, "BA"), .Cells(i, "BA")).Value2
End With
With Worksheets("HRA")
i = .Cells(.Rows.Count, "A").End(xlUp).Row
j = .Cells(1, .Columns.Count).End(xlToLeft).Column
hraA = .Range(.Cells(2, "A"), .Cells(i, "A")).Value2
ReDim hra2C(LBound(hraA, 1) To UBound(hraA, 1), 1 To 2)
For i = LBound(hraA, 1) To UBound(hraA, 1)
m = Application.Match(hraA(i, 1), hrgA, 0)
If Not IsError(m) Then
hra2C(i, 1) = hrgK(m, 1)
hra2C(i, 2) = hrgBA(m, 1)
End If
Next i
.Cells(2, j + 1).Resize(UBound(hra2C, 1), UBound(hra2C, 2)) = hra2C
End With
End Sub
I have a set of data in this format:-
Note: It starts from Jan-17 to Dec-17. However, for this exercise I limit it to 3 months (Jan to Mar).
I wish to convert the data into this format:-
How can i achieve it using Excel?
Thanks in advance.
How about something like below, using a double For Loop to loop through rows and then columns and transfer data to Sheet2 in the desired format (this won't add the headers to Sheet2, but it will give you a some guidance as to how to go about it):
Sub Summarize()
Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'Sheet with data
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2") 'Summarised Sheet
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
For i = 2 To LastRow 'loop through rows
For col = 6 To 14 Step 4 'loop through columns
'replace 14 with (LastCol - 4) if you wish to do all the months instead of just the first 3
FreeRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1 'get the next free row to transfer data to
ws.Range("A" & i & ":D" & i).Copy ws2.Range("A" & FreeRow) 'copy the first 4 columns into the free row
ws2.Cells(FreeRow, 5).Value = "20" & Mid(ws.Cells(1, col).Value, 5, 2) 'get the year from the header
ws2.Cells(FreeRow, 6).Value = Left(ws.Cells(1, col).Value, 3) ' get the month name from header
ws2.Cells(FreeRow, 7).Value = ws.Cells(i, col).Value 'transfer values
ws2.Cells(FreeRow, 8).Value = ws.Cells(i, col + 1).Value
ws2.Cells(FreeRow, 9).Value = ws.Cells(i, col + 2).Value
ws2.Cells(FreeRow, 10).Value = ws.Cells(i, col + 3).Value
Next col
Next i
End Sub
UPDATE:
I've added a couple of lines to the code to attempt to optimize the speed of it, also removed the Copy & Paste and altered it to pass the values without copying anything, please have a look below:
Sub Summarize()
Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'Sheet with data
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2") 'Summarised Sheet
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
'optimize code:
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
For i = 2 To LastRow 'loop through rows
For col = 6 To 14 Step 4 'loop through columns
'replace 14 with (LastCol - 4) if you wish to do all the months instead of just the first 3
FreeRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1 'get the next free row to transfer data to
ws2.Cells(FreeRow, 1).Value = ws.Cells(i, 1).Value
ws2.Cells(FreeRow, 2).Value = ws.Cells(i, 2).Value
ws2.Cells(FreeRow, 3).Value = ws.Cells(i, 3).Value
ws2.Cells(FreeRow, 4).Value = ws.Cells(i, 4).Value
ws2.Cells(FreeRow, 5).Value = "20" & Mid(ws.Cells(1, col).Value, 5, 2) 'get the year from the header
ws2.Cells(FreeRow, 6).Value = Left(ws.Cells(1, col).Value, 3) ' get the month name from header
ws2.Cells(FreeRow, 7).Value = ws.Cells(i, col).Value 'transfer values
ws2.Cells(FreeRow, 8).Value = ws.Cells(i, col + 1).Value
ws2.Cells(FreeRow, 9).Value = ws.Cells(i, col + 2).Value
ws2.Cells(FreeRow, 10).Value = ws.Cells(i, col + 3).Value
Next col
Next i
'return to normal Excel status after macro has finished
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
enter image description hereThere are 2 sheets, Sheet1 and Sheet2.
Sheet1 contain 10 columns and 5 rows with data including blank.
The requirement is to copy the data from Sheet 1 and to put in another sheet Sheet 2, wherein only populate the cell which is not blank.
I get the run time error 1004 - Application or object defined error.
The code snippet is:-
Set wsht1 = ThisWorkbook.Worksheets("Sheet1")
Set wsht2 = Sheets("Sheet2")
finalrow = wsht1.Cells(wsht1.Rows.Count, 1).End(xlUp).Row
For i = 1 To finalrow
If wsht1.Cells(i, 1).Value <> " " Then
Range(Cells(i, 2), Cells(i, 2)).Copy
Worksheets("Sheet2").Select
wsht2.Range(Cells(1, i)).PasteSpecial Paste:=xlPasteFormats
End If
Next i
Can u help me in sorting this out?
You cannot define a range like that:
wsht2.Range(Cells(1, i))
you might use:
wsht2.Cells(1, i).PasteSpecial Paste:=xlPasteFormats
BTW: with this code you won't find empty cells:
If wsht1.Cells(i, 1).Value <> " " Then
you should use:
If wsht1.Cells(i, 1).Value <> "" Then
(the difference is a missing space between the quotes)
if you want to copy the values only and to make it with a loop I'd do the following:
Sub copying()
Set wsht1 = ThisWorkbook.Worksheets("Sheet1")
Set wsht2 = Sheets("Sheet2")
finalrow = wsht1.Cells(wsht1.Rows.Count, 1).End(xlUp).Row
For i = 1 To finalrow
If wsht1.Cells(i, 1).Value <> "" Then
For j = 1 To 5
wsht2.Cells(i, j).Value = wsht1.Cells(i, j).Value
Next j
End If
Next i
End Sub
If you only have 5 cells with data in Sheet 1 and only want those 5 rows copying to Sheet 2 use the following, similar to Shai's answer above with an extra counter for the rows in Sheet 2.
Sub copying()
Set wsht1 = ThisWorkbook.Worksheets("Sheet1")
Set wsht2 = Sheets("Sheet2")
finalrow = wsht1.Cells(wsht1.Rows.Count, 1).End(xlUp).Row
k = 1
For i = 1 To finalrow
If wsht1.Cells(i, 1).Value <> "" Then
For j = 1 To 5
wsht2.Cells(k, j).Value = wsht1.Cells(i, j).Value
Next j
k = k + 1
End If
Next i
End Sub
EDIT
As per your comment if you want to dynamically change j replace For j = 1 To 5 with
For j = 1 To wsht1.Cells(i, Columns.Count).End(xlToLeft).Column
The code below will copy only values in Column A (non-empty cells) from Sheet 1 to Sheet2:
Dim j As Long
Set wsht1 = ThisWorkbook.Worksheets("Sheet1")
Set wsht2 = Sheets("Sheet2")
finalrow = wsht1.Cells(wsht1.Rows.Count, 1).End(xlUp).Row
j = 1
For i = 1 To finalrow
With wsht1
' if you compare to empty string, you need to remove the space inside the quotes
If .Cells(i, 1).Value <> "" And .Cells(i, 1).Value <> " " Then
.Cells(i, 1).Copy ' since you are copying a single cell, there's no need to use a Range
wsht2.Range("A" & j).PasteSpecial Paste:=xlPasteValues, Paste:=xlPasteFormats
j = j + 1
End If
End With
Next i