I'm hoping that someone can help me with my issue. I've searched this site for the correct coding for my spreadsheets, but nothing seems to work.
I have two spreadsheets: I have a front facing form (Sheet1) where the user can input information. Once the user is done inputting their information, they will press a button which will transfer the data to a large data spreadsheet ("Records"). Once the data copies from Sheet1 to Records, I want Sheet1 to clear (so that the next user has a blank form to work from). Additionally, when a new user inputs information, I want that information to go on a line below the previous user's data input on Records.
I hope that this makes sense... This is the code that I'm using now, which doesn't populate anything in "Records" (I've clearly made a mess of this).
Sub BUTTON()
Dim refTable As Variant, trans As Variant
refTable = Array("c = e6", "d = e7", "e=e8", "f=e9", "g=e10")
Dim Row As Long
Row = Worksheets("Records").UsedRange.Rows.Count + 1
For Each trans In refTable
Dim Dest As String, Field As String
Dest = Trim(Left(trans, InStr(1, trans, "=") - 1)) & Row
Field = Trim(Right(trans, Len(trans) - InStr(1, trans, "=")))
Next
End Sub
Does anyone have any advice for coding? Please let me know!
Try this code.
The key bit is to set up the fields as per the order you want them to appear in worksheets("Records") in columns A to V.
For example, in my example e6 maps to column A, e7 to column B etc.
Sub MapInputToColumn()
Dim fields As Range, rw As Integer, col As Integer
Set fields = Union(Range("e6"), Range("e7"), Range("e8"), Range("e9"), Range("e10"))
rw = Worksheets("Records").UsedRange.Rows.Count + 1
For col = 1 To fields.Count
Worksheets("Records").Cells(rw, col) = fields(col, 1)
Next col
fields.ClearContents
End Sub
Related
I am having troubles with a VBA code I want to write. I have looked through different questions here and in other forums but I cant find something that will help my needs.
My problem is about a table named "TableLaw", with about 43 columns and over 10000 rows.
Practically, my need can be divided in two parts:
Verify all fields in column [Comments] from TableLaw. Meaning, I want to see if all data fields in that column are not empty. So I will need to check over 10000 rows. Please note: the fields I am verifying have a formula in them, so they are not really empty. The formula concatenates some cells to form a comment. I need to see if there is a comment or not in each cell
If there are empty fields in the column [Comments], I want to block the workbook from saving. I would like to also highlight the cells that are 'empty' in the column to help the user see which field in the column he needs to work on.
I have no problems with the blocking from saving part, but I am having serious trouble with even forming a For Each or something that will iterate from cell to cell in the column [Comment] checking if the cell is empty or it has a formula only and highlight those cells which are empty.
It is important to use structure names like [Comments] because the user might add new columns to the table.
Thanks, and sorry for the trouble. I am relatively new to VBA and my prior knowledge in programming is few.
I have seen lots of complicated code snippets that I just can not understand, but I got this and I am sure all of you will laugh at my incompetence and doubt if I really did something:
Sub TableTest()
Dim tbl As ListObject
Dim tRows As Long
Dim tCols As Long
Dim lo As ListObject
Dim ws As Worksheet
Dim lr As ListRow
Dim lc As ListColumn
'I used this to get the column number and then use it in a For cycle to go through all cells in the column
col = WorksheetFunction.Match("COMMENTS", Sheets("Orders").Range("5:5"), 0)
Set tbl = ActiveSheet.ListObjects("TableLaw")
With tbl.DataBodyRange
tRows = .Rows.Count
tCols = .Columns.Count
End With
Set ws = ThisWorkbook.Worksheets("Orders")
Set lo = ws.ListObjects("TableLaw")
For Each lr In lo.ListRows
Cells(lr, col).Interior.ColorIndex = 37
Next lr
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'I added the range like this because I do not know how to add the column name.
If WorksheetFunction.CountA(Worksheets("Orders").Range("AM6:AM10500")) <> "" Then
MsgBox "Workbook will not be saved unless all comments are added"
Cancel = True
End If
End Sub
You can check it with the .Value function
ie.
If (Range("A1").Value = "") Then
''' PROCESS CODE
End If
I am still new to VBA and need help with my code. I am currently attempting to code multiple macros in one actual macro. I am trying to get all the dates starting from b5 from one column, Column B, and put them into another column, Column A, starting from A5. The thing is, all the dates in Column B are in (01/24/17) type format, when I need just the month name in text in Column A. I also need the formula to continue until the last cell with a value in Column B.
Here is what I have so far and it doesn't seem to be working:
Sub Macro7()
Worksheets("mac2").Range("A5:A1000").Formula = "=text(if($B5>0,$B5,"""")"
End Sub
Again, I am very new to VBA and am aware that hardcoding ranges and such isn't the best idea. If you could also direct me towards a site that teaches basic VBA that would be much appreciated.
Maybe , if your column B values are text then the code like this
Sub Macro7()
Dim vDB, vR()
Dim i As Long, y As Integer, m As Integer, d As Integer
Dim R As Long
With Worksheets("mac2")
vDB = .Range("b5", .Range("b" & Rows.Count).End(xlUp))
End With
R = UBound(vDB, 1)
ReDim vR(1 To R, 1 To 1)
For i = 1 To R
If vDB(i, 1) > 0 Then
vR(i, 1) = Format(vDB(i, 1), "mmmm")
End If
Next i
Worksheets("mac2").Range("a5").Resize(R) = vR
End Sub
I am trying to build some worksheets that teams can fill in to show which capabilities are required by particular projects. The list of Capabilities is fixed. The project list will be populated by them.
The first worksheet has Projects down one side and Capabilities along the top. If a particular project (that they enter) contains a capability along the top, they must tick the corresponding cell where column and row cross.
In the second worksheet, I would like a list to pre populate based on choices of the first. For example, for each project i would like to have the capabilities (column headers of columns where ticks are in first sheet) listed.
Hopefully I have conveyed this clearly!
It would be greatly appreciated if anyone could even give me a name for what I am trying to do so that I can focus even my own manual search on the internet!
Thankyou in advance :)
Sub test()
Dim shtList, rw As Range, r As Long
Dim rNum As Long, rngProj As Range, cNum As Long
Set shtList = Sheets("Listing")
'assume data starts in A1 and contains no blank rows/columns
Set rngProj = Sheets("Projects").Range("A1").CurrentRegion
r = 2
For rNum = 2 To rngProj.Rows.Count
Set rw = rngProj.Rows(rNum)
shtList.Cells(r, 1).Value = rw.Cells(1).Value 'project
r = r + 1
For cNum = 2 To rw.Columns.Count
If rw.Cells(cNum).Value = "x" Then
shtList.Cells(r, 1).Value = rngProj.Rows(1).Cells(cNum).Value
r = r + 1
End If
Next cNum
Next rNum
End Sub
I have a worksheet1 with a column labeled participant and columns labeled 1-20 (experiment ID numbers).
I have another worksheet2 with data of participants (column) and the experiments (column) they participated in. In the cells under the experiment column, there are multiple experiment ID numbers as participants have participated in multiple experiments. For example a cell could read, "1,4,5".
What I need to do is place an "X", on worksheet1, in the corresponding cells from worksheet2. For example, a cell reading "1,4,5" for participant "003" from worksheet2 would place an "X" in the columns labelled 1, 4, 5 in worksheet1.
I hope this is clear. I am completely new to macros but need help with this as soon as possible.
This is your lucky day. I'm going to walk you through how to do this, with some code. But you have to understand the concepts in order to benefit from it. If you do, you can apply these ideas to many projects.
First, you will need to break down the tasks into manageable easy steps. Macros aren't going to help you because of all the different scenarios. Let's break it down into steps, then address how to accomplish each.
Before we get started, consider the Sheets("worksheet1").Cells(row#, col#) format. This allows you to move through cells on a sheet by incrementing the row number and column number using variables.
In this case, oRow (original Row), nRow (new Row), etc.
Look at the Participant row on worksheet2. : participant = Sheets("worksheet2").Cells(oRow, 1)
Copy the Participant to worksheet1 Column 1. : Sheets("worksheet1").Cells(nRow, 1) = participant
Split the experiments cell into a list: Split(Sheets("worksheet2").Cells(oRow, 2), ",")
Loop through the list items and for each one, put an "X" under the column of the same name.
Repeat steps 1-4 for each row (participant entry) on worksheet2.
Declare your variables. In this case, I'm declaring them outside of the method because I am using them in two methods.
Dim lastRow1 As Integer
Dim lastRow2 As Integer
Dim lastCol1 As Integer
Now the method.
Sub ExperimentMover()
Dim expList() As String
Dim nRow As Integer
Dim oRow As Integer
Dim participant As String
Dim iCol As Integer
Call GetLastRows
nRow = lastRow1 + 1
'Loop through the contents on Worksheet2 one Row at a time
For oRow = 2 To lastRow2
'Get the Participant and store it as a variable.
participant = Sheets("worksheet2").Cells(oRow, 1)
'Create a list of the items in the experiments cell, splitting using ","
expList = Split(Sheets("worksheet2").Cells(oRow, 2), ",")
'Set the participant in worksheet1
Sheets("worksheet1").Cells(nRow, 1) = participant
For Each experiment In expList
'Loop through each column on worksheet1
For iCol = 2 To lastCol1
'Set the column Name and then check it to see if it matches Experiment
colName = Sheets("worksheet1").Cells(1, iCol).Text
If colName = experiment Then
Sheets("worksheet1").Cells(nRow, iCol) = "X"
Exit For
End If
Next iCol
Next experiment
'Increment the row number on worksheet1. It should be matching the row on worksheet2
nRow = nRow + 1
Next oRow
End Sub
Here is the GetLastRows subroutine. I like to separate it because there are many times I need to call it in a project. It's better to just have a method that you can test and verify works, then if you have to change something, you change one thing. Instead of 15 calls and maybe miss one.
Private Sub GetLastRows()
lastRow1 = Sheets("worksheet1").Range("A65536").End(xlUp).Row
lastRow2 = Sheets("worksheet2").Range("A65536").End(xlUp).Row
lastCol1 = Sheets("worksheet1").Cells(1, Columns.Count).End(xlToLeft).Column
End Sub
Edit: Formatting Fix with Code Indentation
I have an excel which serves to record the food you ingest for a specific day and meal. I hav a grid in which each line represent a food you ate, how much sugar it has, etc.
Then i've added an save button to save all the data to a table in another sheet.
This is what i have tried
Public Sub addDataToTable(ByVal strTableName As String, ByRef arrData As Variant)
Dim lLastRow As Long
Dim iHeader As Integer
Dim iCount As Integer
With Worksheets(4).ListObjects(strTableName)
'find the last row of the list
lLastRow = Worksheets(4).ListObjects(strTableName).ListRows.Count
'shift from an extra row if list has header
If .Sort.Header = xlYes Then
iHeader = 1
Else
iHeader = 0
End If
End With
'Cycle the array to add each value
For iCount = LBound(arrData) To UBound(arrData)
**Worksheets(4).Cells(lLastRow + 1, iCount).Value = arrData(iCount)**
Next iCount
End Sub
but i keep getting the same error on the highlighted line:
Application-defined or object-defined error
What i am doing wrong?
Thanks in advance!
You don't say which version of Excel you are using. This is written for 2007/2010 (a different apprach is required for Excel 2003 )
You also don't say how you are calling addDataToTable and what you are passing into arrData.
I'm guessing you are passing a 0 based array. If this is the case (and the Table starts in Column A) then iCount will count from 0 and .Cells(lLastRow + 1, iCount) will try to reference column 0 which is invalid.
You are also not taking advantage of the ListObject. Your code assumes the ListObject1 is located starting at row 1. If this is not the case your code will place the data in the wrong row.
Here's an alternative that utilised the ListObject
Sub MyAdd(ByVal strTableName As String, ByRef arrData As Variant)
Dim Tbl As ListObject
Dim NewRow As ListRow
' Based on OP
' Set Tbl = Worksheets(4).ListObjects(strTableName)
' Or better, get list on any sheet in workbook
Set Tbl = Range(strTableName).ListObject
Set NewRow = Tbl.ListRows.Add(AlwaysInsert:=True)
' Handle Arrays and Ranges
If TypeName(arrData) = "Range" Then
NewRow.Range = arrData.Value
Else
NewRow.Range = arrData
End If
End Sub
Can be called in a variety of ways:
Sub zx()
' Pass a variant array copied from a range
MyAdd "MyTable", [G1:J1].Value
' Pass a range
MyAdd "MyTable", [G1:J1]
' Pass an array
MyAdd "MyTable", Array(1, 2, 3, 4)
End Sub
Tbl.ListRows.Add doesn't work for me and I believe lot others are facing the same problem. I use the following workaround:
'First check if the last row is empty; if not, add a row
If table.ListRows.count > 0 Then
Set lastRow = table.ListRows(table.ListRows.count).Range
For col = 1 To lastRow.Columns.count
If Trim(CStr(lastRow.Cells(1, col).Value)) <> "" Then
lastRow.Cells(1, col).EntireRow.Insert
'Cut last row and paste to second last
lastRow.Cut Destination:=table.ListRows(table.ListRows.count - 1).Range
Exit For
End If
Next col
End If
'Populate last row with the form data
Set lastRow = table.ListRows(table.ListRows.count).Range
Range("E7:E10").Copy
lastRow.PasteSpecial Transpose:=True
Range("E7").Select
Application.CutCopyMode = False
Hope it helps someone out there.
I had the same error message and after lots of trial and error found out that it was caused by an advanced filter which was set on the ListObject.
After clearing the advanced filter .listrows.add worked fine again.
To clear the filter I use this - no idea how one could clear the filter only for the specific listobject instead of the complete worksheet.
Worksheets("mysheet").ShowAllData
I actually just found that if you want to add multiple rows below the selection in your table
Selection.ListObject.ListRows.Add AlwaysInsert:=True works really well. I just duplicated the code five times to add five rows to my table
I had the same problem before and i fixed it by creating the same table in a new sheet and deleting all the name ranges associated to the table, i believe whene you're using listobjects you're not alowed to have name ranges contained within your table hope that helps thanks
Ran into this issue today (Excel crashes on adding rows using .ListRows.Add).
After reading this post and checking my table, I realized the calculations of the formula's in some of the cells in the row depend on a value in other cells.
In my case of cells in a higher column AND even cells with a formula!
The solution was to fill the new added row from back to front, so calculations would not go wrong.
Excel normally can deal with formula's in different cells, but it seems adding a row in a table kicks of a recalculation in order of the columns (A,B,C,etc..).
Hope this helps clearing issues with .ListRows.Add
As using ListRow.Add can be a huge bottle neck, we should only use it if it can’t be avoided.
If performance is important to you, use this function here to resize the table, which is quite faster than adding rows the recommended way.
Be aware that this will overwrite data below your table if there is any!
This function is based on the accepted answer of Chris Neilsen
Public Sub AddRowToTable(ByRef tableName As String, ByRef data As Variant)
Dim tableLO As ListObject
Dim tableRange As Range
Dim newRow As Range
Set tableLO = Range(tableName).ListObject
tableLO.AutoFilter.ShowAllData
If (tableLO.ListRows.Count = 0) Then
Set newRow = tableLO.ListRows.Add(AlwaysInsert:=True).Range
Else
Set tableRange = tableLO.Range
tableLO.Resize tableRange.Resize(tableRange.Rows.Count + 1, tableRange.Columns.Count)
Set newRow = tableLO.ListRows(tableLO.ListRows.Count).Range
End If
If TypeName(data) = "Range" Then
newRow = data.Value
Else
newRow = data
End If
End Sub
Just delete the table and create a new table with a different name. Also Don't delete entire row for that table. It seems when entire row containing table row is delete it damages the DataBodyRange is damaged