How can I send all items from the listbox to worksheet table?
Tried this code but it's not working.
Worksheets("RIS").Range("C" & Rows.Count).End(xlUp).Offset(1).Value = lbCart.List(i)
ListBox named "lbCart"
worksheet "RIS" and table named "Items"
To become like this
I notice that your lbCart columns don't align with those on your spreadsheet, so you need a way to write the data to the specific sheet columns of your template. This makes the task slightly more complicated than the usual copy list to variant, copy variant to range process:
Dim x
x = Me.lbCart.List
Range("C2").Resize(UBound(x) + 1, UBound(x, 1)).Value = x
I came up with this - which will allow you to define where each column goes by cycling through each cell:
columnarray = Array("C", "B", "D") ' first column writes to C, then B, then D
With Worksheets("RIS")
For c = 0 To UBound(columnarray)
For r = 0 To lbCart.ListCount - 1
Range(columnarray(c) & "2").Offset(r).Value = lbCart.List(r, c)
Next
Next
End With
Related
I have two sheets :
Sheet 1 consist of :
Sheet 2 consist of :
And the output should show in M column in Sheet1. I am attaching the sample output here :
So,what I have here is ID in Sheet 1, for eg : ID 'US' has Abhay,Carl and Dev
and in Sheet3, I have names in column and ID in Rows.
What i want is my Sample output column should populate using macro based on matched values from Sheet3
I am using below logic but something is going wrong :
For i = 2 To 10
j = i + 1
If ThisWorkbook.Sheets("Input").Range("N" & i) = ThisWorkbook.Sheets("Sheet3").Range("A" & i) And ThisWorkbook.Sheets("Input").Range("K" & i) = ThisWorkbook.Sheets("Sheet3").Range("B1") Then
ThisWorkbook.Sheets("Input").Range("O" & i) = ThisWorkbook.Sheets("Sheet3").Range("B" & j)
End If
Next i
Since you asked for a VBA solution, please see the code below.
Dim colLen As Integer
Dim i As Integer
Dim colPt As Integer
Dim rowPt As Integer
' Counts number of rows on Sheet 1, column B.
colLen = Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row
' Loops through all names on Sheet 1.
For i = 2 To colLen
' Retain US or NA ID for blank cells.
If Sheets(1).Cells(i, 1) <> "" Then
If Sheets(1).Cells(i, 1) = "US" Then
colPt = 2
Else
colPt = 3
End If
End If
' Find name on Sheet 2 and set row.
rowPt = Sheets(2).Range("A:A").Find(Sheets(1).Cells(i, 2)).Row
' Add ID from Sheet 2 to Sheet 3
Sheets(1).Cells(i, 3) = Sheets(2).Cells(rowPt, colPt)
Next i
Assumptions:
Sheet 1 is the main worksheet, sheet 2 has the lookup data.
All names in the lookup data are unique.
I would recommend including the ID in every row instead of treating it as a heading but that's preference. There are formula solutions that would work for this as well if you want to skip VBA.
There are a few ways to approach this. Below is one of them:
NOTE: for simplicity, I have kept my data on one sheet. You can amend the below formulas as your data is on 2 sheets. Saying that, I have used the same columns as you have in your query
Solution:
Have a "holding column". In my example, I used column J as the holding column (you can hide this column if you want). In J2, type the following formula: =IF(ISBLANK($K2), $J1,$K2). Copy the formula down to all used rows. Then copy the following formula in M2: =VLOOKUP($L2,$A$3:$C$8,IF($J2="US",2,3),FALSE). As per before, copy the formula down to all used rows. This should give you your results
I have an excel file that contains data exported from LTSpice simulations. There are 280 different runs however the data is exported as two columns (time and voltage) with a run cell at the start of a new run. The number of data points in each run varies. Looks something like this:
Run 1/280
Time1 Voltage1
Time2 Voltage2
Run 2/280
Time1 Voltage1
Time2 Voltage2
Time3 Voltage3
Run 3/280
I would like to have the run cells as row and the time and voltage columns beneath them.
Run 1/280 Run 2/280 Run 3/280
Time1 Voltage1 Time1 Voltage1
Time2 Voltage2 Time2 Voltage2
Time3 Voltage3
I haven't found an easy way to do this yet, so any help would be appreciated.
Thanks
Without VBA...
For each row of your input list, you need to identify its type (Run x/xxx header or terminal, voltage pair) and the row and pair of columns in the output where this input row belongs.
In the picture below, columns A and B perform this task. Column A identifies the output column pair and B the output row, where row 0 indicates the header row of the output.
The header row of the output utilises the fact that if an array is sorted in ascending order and has repeated values then MATCH(x,array,0) finds the index of the first element in array equal to x. The cumbersome repetition of the SUMPRODUCT term in the formulae for the other rows is necesssary for the following reason. If there is no matching pair in columns A and B to the current output row and column pair number then the SUMPRODUCT delivers 0 and, unfortunately, the INDEX(array,SUMPRODUCT()) term evaluates to INDEX(array,0) which delivers the first element of array (*) - which is not what is wanted.
You obviously need sufficient helper values in row 1 and column E of the worksheet in the output area - the maximum values of columns B and A, respectively determine the requirements. Oversizing the output (as the picture has done) is not a problem as the formulae in any redundant positions simply evaluate to "".
(*) In fact, for a single column array the formula =INDEX(array,0) evaluates to the array itself. When used as cell formula (rather than being used as an array formula across a range of cells) formula simply picks the first value from array.
Please try this code.
Sub SplitToColumns()
' 16 Sep 2017
Dim WsS As Worksheet ' S = "Source"
Dim WsD As Worksheet ' D = "Destination"
Dim WsDName As String
Dim RunId As String ' first word in "Run 1/280"
Dim RowId As Variant ' value in WsS.Column(A)
Dim Rl As Long ' last row (WsS)
Dim Rs As Long, Rd As Long ' row numbers
Dim Cd As Long ' column (WsD)
WsDName = "RemoteMan" ' change to a valid tab name
Application.ScreenUpdating = False
On Error Resume Next
Set WsD = Worksheets(WsDName)
If Err Then
' create WsD if it doesn't exist:
Set WsD = Worksheets.Add(After:=Worksheets(Worksheets.Count))
WsD.Name = WsDName
Cd = -1
Else
' continue adding new data to the right of existing,
With WsD.UsedRange
Cd = .Columns.Count - 1
If Cd = 1 And .Rows.Count = 1 Then Cd = -1
End With
End If
Set WsS = Worksheets("Remote") ' change to a valid tab name
With WsS
' presume "Run" & Time in column A, Voltage in Column B
' presume: no blank rows
Rl = .Cells(Rows.Count, "A").End(xlUp).Row
RunId = .Cells(2, 1).Value ' row 2 must have the RunId
RunId = Left(RunId, InStr(RunId, " ") - 1)
For Rs = 2 To Rl ' assume data start in row 2 (A1 may not be blank!)
RowId = .Cells(Rs, "A").Value
If InStr(1, RowId, RunId, vbTextCompare) = 1 Then
Rd = 1 ' first row to use in WsD
Cd = Cd + 2 ' determine next columns
End If
WsD.Cells(Rd, Cd).Value = RowId
WsD.Cells(Rd, Cd + 1).Value = .Cells(Rs, "B").Value
Rd = Rd + 1 ' next row to use
Next Rs
End With
Application.ScreenUpdating = True
End Sub
I have files of data with the following format:
In column A, identifiers occur either doubly (e.g. 302_60) or singularly (e.g.310_58). Additional information is present in column B.
What I want to do is:
tag the rows that have single identifiers in column A with
TRUE/FALSE in Column C
for any TRUE tag, insert a line BELOW
copy into the inserted row the contents of the ENTIRE tagged row (here just columns A,B)
I solved #1 using =COUNTIF(A:A, A1)=1
I then wrote a VBA script to solve #2
Sub ins_below_and_copy()
Dim c As Range
For Each c In Range("C1:C100")
If InStr(1, c, "TRUE", vbTextCompare) > 0 Then
Rows(c.Offset(1, 0).Row & ":" & c.Offset(1, 0).Row).Insert Shift:=xlDown
End If
Next c
End Sub
Achieving the desired end result (#3)
seems simple enough, right? I have been trying .Copy and .Paste commands, but keep getting type-mismatch errors, an error that does not make sense to me (since I am not a competent VBA coder). Any ideas?
You have down all the hard work, filling in the gaps is easy. Select the two columns, HOME > Editing - Find & Select, Go To Special..., Blanks, OK, =, UP and Ctrl+Enter.
You can run this after you have your empty rows created.
Dim sheet As String
Dim lastRow As Long
sheet = "SheetName"
lastRow = Sheets(sheet).Range("A" & Rows.Count).End(xlUp).Row
For r = 2 To lastRow 'Assuming you have a Header Row
If Sheets(sheet).Cells(r, 1) = "" Then
Sheets(sheet).Cells(r - 1, 3) = "FALSE"
Sheets(sheet).Cells(r, 1) = Sheets(sheet).Cells(r - 1, 1)
Sheets(sheet).Cells(r, 2) = Sheets(sheet).Cells(r - 1, 2)
Sheets(sheet).Cells(r, 3) = Sheets(sheet).Cells(r - 1, 3)
End If
Next r
I have an excel data as follow and i want to concatenate skills that seperated by comma according by person name like this;
Irakli Beridze | C#, Python, Java
Parpali Zurashvili | C++, C
I can achieve according to followed sceanorio but i have n pieces data row.
You can do it using a helper column like this:
Insert filters and sort by name:
In cell C2, put the formula:
=IF(A2=A3,0,1)
0 will be where the 'copies' will be and 1 will be where the final line to be kept will be.
In cell D2, put the value of B2, and in D3, put the following formula:
=IF(A3=A2,D2&", "&B3,B3)
Now that that's done, copy and paste values in column D (Copy whole column, use paste special and pick 'Values'). Remove the filter, add back the filter but this time on all 4 columns and filter on 0 in column C:
Delete those rows and clear the filters. Finally, sort column A:
You can now delete columns B and C.
If you don't mind VBA you can use the following:
Sub ConcatRows()
Dim arr As Variant
Dim i As Long
Dim d As Dictionary
'Create a dictionary to hold all Name and Skill Values
Set d = CreateObject("Scripting.Dictionary")
'Fill an array with all Values
arr = Range("A2", Cells(Rows.Count, 2).End(xlUp))
'Loop the Values and and them into a dictionary
For i = LBound(arr) To UBound(arr)
'If Name already in list then Add Skill to Item value of Name Key
If d.Exists(arr(i, 1)) Then
d(arr(i, 1)) = d(arr(i, 1)) & ", " & arr(i, 2)
'If Name isn't already in list then add name with its first Skill
Else
d.Add arr(i, 1), arr(i, 2)
End If
Next i
'Write all Name back to Worksheet
Range("A2").Resize(d.Count) = Application.Transpose(d.Keys)
'Write all Skills Back to worksheet
Range("B2").Resize(d.Count) = Application.Transpose(d.Items)
End Sub
I am having a problem with finding duplicates in an excel column that is created via VBscript.
I currently am grabbing data from a DB opening an excel file, placing the data within and then sorting the data alphabetically ascending on column E (if this isn't needed it can easily be removed).
Now the problem that I am faced with is that I am trying to find any duplicates within that column E (Errors).
If there is a duplicate I would like to copy the duplicate and paste it into another sheet (column A) that I have created
Set oWS7 = oWB.Worksheets(7)
oWB.Sheets(7).Name = "Dups"
And in column B of oWS7 I would like to put all the corresponding column C's (accounts) from the original worksheet.
So that there would be a 1 Error to many account's ratio. If there are no duplicates I would like to have them left alone. I'm not sure how clear this is but any questions/help on this would be much appreciated.
Thanks in advance.
I'm going to make the following assumptions:
The content in the worksheet starts in the first row
The first row (and only the first row) is a header row.
There are no empty rows between header row and data rows.
The data is already sorted.
If these assumptions apply the following should work (once you put in the correct sheet number):
Set data = oWB.Sheets(...) '<-- insert correct sheet number here
j = 1
For i = 3 To data.UsedRange.Rows.Count
If data.Cells(i, 5).Value = data.Cells(i-1, 5).Value Then
oWS7.Cells(j, 1).Value = data.Cells(i, 5).Value
oWS7.Cells(j, 2).Value = data.Cells(i, 3).Value
j = j + 1
End If
Next
'How To find Repeted Cell values from source excel sheet.
Set oXL = CreateObject("Excel.application")
oXL.Visible = True
Set oWB = oXL.Workbooks.Open("ExcelFilePath")
Set oSheet = oWB.Worksheets("Sheet1") 'Source Sheet in workbook
r = oSheet.usedrange.rows.Count
c = oSheet.usedrange.columns.Count
inttotal = 0
For i = 1 To r
For j = 1 To c
If oSheet.Cells(i,j).Value = "aaaa" Then
inttotal = inttotal+1
End If
Next
Next
MsgBox inttotal
oWB.Close
oXL.Quit