Task: I am trying to copy several cells in a row ( 13 at the moment) that may contain some blanks. I want to paste these values into 13 rows within a column.
Attempts: I have not had any luck with .Pastespecial , Paste:=xlPasteValues, SkipBlanks:=True, Transpose:= True.
Current Approach: I am trying to use FOR loops to validate and transfer.
Dim j As Long, I As Long
For j = 3 To 16
If Not IsEmpty(Cells(aCell.Row, j)) Then
For i = 16 To 33
oSht.Cells(i, 4).Value = Cells(aCell.Row, j).Value
Next i
End If
Next j
Problem: However this code is taking the last nonblank cell from Cells(aCell.Row, j). and displaying it for all values of i in oSht.Cells(i, 4).
Request: I am trying to determine what the error is with my FOR Loops or if there is an easier approach to copying several cells and pasting all nonblank cells.
without knowing the context is a bit difficult to provide a proper answer but I think the problem is the inner loop, it should be just a counter, like this:
Dim j As Long, I As Long
For j = 3 To 16
If Not IsEmpty(Cells(aCell.Row, j)) Then
i=i+1
oSht.Cells(i, 4).Value = Cells(aCell.Row, j).Value
End If
Next j
Related
I'm new programming over VBA; for the moment I have created a single macro for a single row-column; in this particular case for Row "2" and columns "M2:BF2" but I need this MACRO- command to run over the next 320 rows and I do not know how to do it. this is my command:
enter image description here
I will appreciate any advice or guidance,
Best for everybody,
Jorge
Nested for loops are the way to go:
Sub test()
Dim i As Long, j As Long
For i = 2 To 320
For j = 14 To 58 Step 2
If Cells(i, j).Value = 0 Then Cells(i, j).Value = Cells(i, j - 1).Value
Next j
Next i
End Sub
See this for information about loops in VBA.
I suggest you do this using Excel IF(condition, then, else) Formula.. Then once you complete one row, you can copy paste the same formula to all the rows and viola you have the answers.
Incase you insist on doing this using VBA, then you have to use a for loop.
For i = 2 to 320
If Range("N" & i).value = 0 then Range("N" & i).value = Range("M" & i).value
'.... and so on...
Next i
I've been searching for a way to concatenate my Excel (or any other tool/software handling tables) rows based on common cells. As an example:
I have this tab-stop divided table. Each of the values is in a separate row:
angeb* 12 16 18
zyste* 60 61
zynisch* 12
zyste* 60
abstreit* 70
anflunker* 70
angeb* 70
I want to concatenate the rows in a way that the result would be:
angeb* 12 16 18 70
zyste* 60 61
zynisch* 12
abstreit* 70
anflunker* 70
It does work by doing as proposed in this tutorial, but it only concatenates single cell values into another single cell. I also tried going the path basically proposed by this so question and finally leading me to VLOOKUP (description). But they all concatenate in cells.
Basically pretty simple, I need to merge cells with the same Column 1, but keep the columns, just concatenate beyond. The second row can then be deleted, once it is added to the first one. I tried adapting the above scripts, but I could not make it work in one step, just with then converting comma separated values into cells and copying them to new columns. I am not an expert with VBA, but this seems like a very simple functionality, I might as well be missing something. Any help is greatly appreciated.
I have written and color-coded each part of what I did, but here is the general method:
Sort all data A-Z
Use a CountIf statement to count how many times a particular data row shows up.
Assuming 3 columns of data, find MAX() of MaxRows, multiply (here, 3 columns x 2 Rows maximum observed = 6 data max).
Copy the labels, remove duplicates [Green] so you have a condensed table.
Use IndexMatch equations, coupled with IF and IFERROR statements to re-sort the data. Note the +1 for Columns P-Q)
Problem - you can still get a gap, but it's all in the same rows now!
Here's a quick Youtube video on how I did it.
TSpinde Answer 1
I was a little confused by your question so I only concatenated names that were exactly the same.
So the way my code works is it makes an array of tags and when it runs into one that it already has it looks for the next empty slot in the original row. It then adds the value in and does this until it hits an empty cell in the new row. There's a bit of funny business with decreasing the lastrow value and changing the row it's on, but its necessary for it to move to the correct row of data in the next cycle.
This macro assumes that all possible data entries are side by side, for example there wont be a value in C2 and E2 if D2 is empty.
Sub macro()
Dim LastRow As Long
Dim LastCol As Long
Dim TagArray() As String
Dim count As Long
Dim i As Long
Dim j As Long
Dim PreExisting As Boolean
Dim Targetrow As Long
ReDim TagArray(1 To 1)
LastRow = Worksheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = Worksheets(1).Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
TagArray(1) = Worksheets(1).Range("A1").Value
For i = 2 To LastRow
PreExisting = False
For j = 1 To UBound(TagArray)
If Worksheets(1).Cells(i, 1) = TagArray(j) Then
PreExisting = True
Targetrow = j
Exit For
End If
Next j
If PreExisting Then
For j = 2 To LastCol
If Not IsEmpty(Worksheets(1).Cells(i, j)) Then
For count = 1 To LastCol
If IsEmpty(Worksheets(1).Cells(Targetrow, count)) Then
Worksheets(1).Cells(Targetrow, count) = Worksheets(1).Cells(i, j)
Exit For
Else
If count = LastCol Then
LastCol = LastCol + 1
Worksheets(1).Cells(Targetrow, LastCol) = Worksheets(1).Cells(i, j).Value
End If
End If
Next count
Else
Exit For
End If
Next j
Worksheets(1).Rows(i).Delete
LastRow = LastRow - 1
i = i - 1
Else
ReDim Preserve TagArray(1 To UBound(TagArray) + 1)
TagArray(UBound(TagArray)) = Worksheets(1).Cells(i, 1)
End If
Next i
End Sub
Hopefully, you find this useful if you wanted to use it in VBA instead of worksheet functions.
In Microsoft Excel I want to create a table to be something like in picture below.
I already try using vlookup and index but I can't make it work like I want.
Please help me
Try to use VBA:
Sub TransformTbl()
Dim i As Long, j As Long, cnt As Long
With ActiveSheet
.Range("G1:I1") = Array("Date", "Event", "Place")
cnt = 1
For j = 2 To 4 'column
For i = 2 To 5 'row
If Len(.Cells(i, j)) <> 0 Then
cnt = cnt + 1
.Cells(cnt, 7) = .Cells(1, j) 'Date
.Cells(cnt, 8) = .Cells(i, j) 'Event
.Cells(cnt, 9) = .Cells(i, 1) 'Place
End If
Next i
Next j
End With
End Sub
I wrote a solution and it works fine with me. The formula is really complex and probably hard to understand. Though I'll try my best to explain it, updating the formula may still be a difficult work. All these three formula are written in Array Formula, press ctrl+shift+enter to complete.
Formula in G6:
=IFERROR(OFFSET($A$5,0,SMALL(
IF($B$6:$D$9<>"",1,99999999)*(COLUMN($B$6:$D$9)-1),ROW(A1))),"")
The outer IFERROR keeps your sheet from any #Err. The OFFSET for calling the right date. The formula inside SMALL generate an array with the rule: If there is an event, the value will be the number of the date for offset, otherwise, it will be 99999999 which giving the OFFSET an error and be blocked by IFERROR. With the data you gave, the array will be
{ 1,99999999, 3;
1, 2,99999999;
1,99999999,99999999;
99999999,99999999, 3 }
Formula in H6:
=IFERROR(OFFSET($A$5,
SMALL(IF($B$6:$D$9<>"",ROW($B$6:$D$9)-5)*
IF(COLUMN($B$6:$D$9)=MATCH(G6,$B$5:$D$5,0)+1,1,99999999),99999999),COUNTIF($G$6:G6,G6)),
MATCH(G6,$B$5:$D$5,0)),"")
The IFERROR and OFFSET works the same as G6. The formula in OFFSET.ROW generate nearly the same array as G6. This time the value is the row of event with the date determined by column G. Other gives 999999999 or more.
Formula in I6:
=IFERROR(OFFSET($A$5,MAX((ROW($B$6:$D$9)-5)*($B$6:$D$9=H6)*
(COLUMN($B$6:$D$9)=MATCH(G6,$B$5:$D$5,0)+1)),0),"")
IFERROR and OFFSET are still the same. And this time only the event which matches the date and the name of itself has a value, other remains 0.
Finally, I apologize for the poor readability. Wish someone can help me out with this :]
I need a VBA loop which searches through an entire worksheet for, say, the word "COUNTRY", and every time it is encountered, it replaces the cell +1 to the right with the word "UK".
Rest assured that this is necessary and can't be done with a column of formulae, since the word COUNTRY is scattered around the worksheet a large number of times and in an irregular way.
I really wanted to start off with some code but I can't find the way to do this. Thanks in advance!
Here is your VBA code,
Sub funcOffset()
Dim i As Long, j As Long
For j = 1 To 255
For i = 1 To Cells(Rows.Count, j).End(xlUp).Row
If Cells(i, j) = "COUNTRY" Or InStr(Cells(i, j), "COUNTRY") > 0 Then
Cells(i, j + 1) = "UK"
End If
Next i
Next j
End Sub
Note:- the code is case sensitive and checks COUNTRY in upper case only. Alter it accordingly if you need.
I have a spreadsheet, BO2009, that is 300k rows long. Only one column contains a formula The others are all pasted values so only one formula needs to be calculated in the entire workbook. Here is the formula: =IFERROR(INDEX('RE2009'!H:H,MATCH('BO2009'!A2,'RE2009'!A:A,0)),1) This formula is copied down to the bottom of the sheet, so 300k times.
RE2009 sheet has 180k rows. 'RE2009'!H:H contains decimal numbers and 'RE2009'!A:A, 'BO2009'!A:A contain ID codes--an 8 character combination of numbers and letters. Both 'RE2009'!A:A, 'BO2009'!A:A are formatted as general.
I use INDEX/MATCH all the time and while most of my spreadsheets are not 300k long, 60k-100k is typical. Right now it takes a couple minutes of my CPU devoting 99% to Excel in order to finish the calculation.
Is that normal? Is there any way to improve Excel's performance?
On top of that I am getting inaccurate results: instead of 0.3 the lookup produces an error.
As suggested, I have filtered the BO2009 sheet down to 80k rows, but still have the same issues. I decided to look at a single formula in particular: =IFERROR(INDEX('RE2009'!H:H,MATCH('BO2009'!A108661,'RE2009'!A:A,0)),1) to see if it worked correctly. The ID that it is looking for with the MATCH function is the 3rd entry in the lookup array, but it still isn't able to produce the correct value (0.3)
It seems that you've found a satisfactory solution to your problem(s) but as a matter of curiosity, you may wish to time this against your current formula based solution to see if there is a measurable increase in speed.
Sub index_match_mem()
Dim v As Long, vVALs As Variant, vTMP As Variant
Dim dRE2009 As Object
Debug.Print Timer
Application.ScreenUpdating = False
With Worksheets("RE2009")
With .Cells(1, 1).CurrentRegion
With .Resize(.Rows.Count, 8)
vTMP = .Cells.Value2
End With
End With
End With
Set dRE2009 = CreateObject("Scripting.Dictionary")
dRE2009.CompareMode = vbTextCompare
For v = LBound(vTMP, 1) To UBound(vTMP, 1)
If Not dRE2009.exists(vTMP(v, 1)) Then _
dRE2009.Add Key:=vTMP(v, 1), Item:=vTMP(v, 8)
Next v
With Worksheets("BO2009")
With .Cells(1, 1).CurrentRegion
With .Resize(.Rows.Count - 1, 2).Offset(1, 0)
vVALs = .Cells.Value2
For v = UBound(vVALs, 1) To LBound(vVALs, 1) Step -1
If dRE2009.exists(vVALs(v, 1)) Then
vVALs(v, 2) = dRE2009.Item(vVALs(v, 1))
Else
vVALs(v, 2) = 1
End If
Next v
.Cells = vVALs
End With
End With
End With
dRE2009.RemoveAll: Set dRE2009 = Nothing
Application.ScreenUpdating = True
Debug.Print Timer
End Sub
This will produce static values in column B of the BO2009 worksheet. The elapsed start and stop in seconds will be in the VBE's Immediate window (Ctrl+G)