I built a tracking sheet in Microsoft Excel and later for sharing and work simultaneously I esport it in Google Sheet. I implement this code to a button to save the data I entered in a particular sheet to another one:
Sub SaveInvoice()
Dim Rng As Range, TargetRow As Long
Set Rng = Range("C3,C5,C7,C9,C11")
If Application.WorksheetFunction.CountA(Rng) < Rng.Cells.Count Then
MsgBox ("Please fill in empty cells before saving")
Exit Sub
End If
With Sheets("Invoices")
TargetRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & TargetRow).Resize(, 5) = Array(Rng.Cells(1), Rng.Cells(3), Rng.Cells(5), Rng.Cells(7), Rng.Cells(9))
End With
Rng = "": Set Rng = Nothing:
End Sub
but I tried to impliment this code in google sheets for same reason but I have a problem because it saves in Invoices cell A4 only
this is the code:
function copy() {
var ss = SpreadsheetApp.getActiveSpreadsheet();
var s1 = ss.getSheetByName('New Inv Entry');
var Properties = PropertiesService.getScriptProperties();
var lastrow = Properties.getProperty('lastrow');
if(lastrow==null) lastrow=1;
else lastrow = parseInt(lastrow);
Properties.setProperty('lastrow',(lastrow+1));
var v = s1.getRange('A'+lastrow).getValue();
ss.getSheetByName('Invoices').getRange('A4').setValue(v);
};
any help please?
Shouldn't ss.getSheetByName('Invoices').getRange('A4').setValue(v); be ss.getSheetByName('Invoices').getRange('A' + lastrow).setValue(v); instead?
Hereunder I am posting the function that I edit. The problem is when this function is executed, the data entered in New Inv Entry didn't goes to last row but it goes to a row that it have data already in it.
function copy() {
var ss = SpreadsheetApp.getActiveSpreadsheet();
var s1 = ss.getSheetByName('New Inv Entry');
var Properties = PropertiesService.getScriptProperties();
var lastrow = Properties.getProperty('lastrow');
if(lastrow==null) lastrow=1;
else lastrow = parseInt(lastrow);
Properties.setProperty('lastrow',(lastrow+1));
var v = s1.getRange('C3:G11').getValue();
ss.getSheetByName('Invoices').getRange('A' + lastrow).setValue(v);
};
Related
I have the following code That I need to loop for ~100 rows. Instead of writing out for each row, is there a way to add a loop feature in here to repeat until a row is blank? I am having trouble figuring out the Do While Loop feature and incorporating it within the code below. Thanks!
Sub Excel_INDIRECT_Function()
'declare a variable
Dim ws As Worksheet
Set ws = Worksheets("TOC")
'apply the Excel INDIRECT function
ws.Range("$F8").Formula = "=INDIRECT($W8&""Q24"")"
ws.Range("$G8").Formula = "=INDIRECT($W8&""Q30"")"
ws.Range("$I8").Formula = "=INDIRECT($W8&""I56"")"
ws.Range("$J8").Formula = "=INDIRECT($W8&""Q34"")"
ws.Range("$K8").Formula = "=INDIRECT($W8&""D7"")"
ws.Range("$L8").Formula = "=INDIRECT($W8&""L56"")"
ws.Range("$M8").Formula = "=INDIRECT($W8&""M56"")"
ws.Range("$N8").Formula = "=INDIRECT($W8&""N56"")"
ws.Range("$O8").Formula = "=INDIRECT($W8&""O56"")"
ws.Range("$R8").Formula = "=INDIRECT($W8&""D6"")"
End Sub
I am looking to get this accomplished for multiple rows without writing this code ~100 times. Thanks so much.
I'm not sure you need a loop.
This code will put the formulas in columns F, G etc. from row 8 down to the last row of data in column W.
Sub Excel_INDIRECT_Function()
'declare a variable
Dim ws As Worksheet
Dim lngLastRow As Long
Set ws = Worksheets("TOC")
lngLastRow = ws.Range("W" & Rows.Count).End(xlUp).Row
'apply the Excel INDIRECT function
ws.Range("F8:F" & lngLastRow).Formula = "=INDIRECT($W8&""Q24"")"
ws.Range("G8:G" & lngLastRow).Formula = "=INDIRECT($W8&""Q30"")"
ws.Range("I8:I" & lngLastRow).Formula = "=INDIRECT($W8&""I56"")"
ws.Range("J8:J" & lngLastRow).Formula = "=INDIRECT($W8&""Q34"")"
ws.Range("K8:K" & lngLastRow).Formula = "=INDIRECT($W8&""D7"")"
ws.Range("L8:L" & lngLastRow).Formula = "=INDIRECT($W8&""L56"")"
ws.Range("M8:M" & lngLastRow).Formula = "=INDIRECT($W8&""M56"")"
ws.Range("N8:N" & lngLastRow).Formula = "=INDIRECT($W8&""N56"")"
ws.Range("O8:O" & lngLastRow).Formula = "=INDIRECT($W8&""O56"")"
ws.Range("R8:R" & lngLastRow).Formula = "=INDIRECT($W8&""D6"")"
End Sub
I wrote a script in Google app script to search a value in a sheet and update the row as per user entered values.It works fine with google sheets.But when I downloaded the document as an excel file, I expected the script to be even downloaded and converted to VBA macro, but that is not happening and since I don't have any experience with writing VBA scripts, is there any tol that can be used to translate the .gs to the VBA.
The following is the function if that helps:
function test() {
var sheet1 = SpreadsheetApp.getActiveSpreadsheet().getSheetByName('Sheet1');
var sheet2 = SpreadsheetApp.getActiveSpreadsheet().getSheetByName('Sheet2');
var spreadsheet = SpreadsheetApp.getActive();
sheet2.getRange('B5:B7').activate();
var idForSearch = sheet2.getRange("B5").getValue();
var data = sheet1.getDataRange().getValues();
var rownumber;
for(var i = 0; i<data.length;i++){
if(data[i][0] == idForSearch){ //[0] because column A
Logger.log((i+1))
rownumber= i+1;
}
}
spreadsheet.setActiveSheet(spreadsheet.getSheetByName('Sheet1'), true);
spreadsheet.getRange('A'+rownumber+':'+'C'+rownumber).activate();
spreadsheet.getRange('Sheet2!B5:B7').copyTo(spreadsheet.getActiveRange(), SpreadsheetApp.CopyPasteType.PASTE_NORMAL, true);
};
thanks in advance for any help.
Please test the next code. I do not have your data to be processed and I made it only theoretically, without testing...
Private Sub testConvert()
Dim actWork As Workbook, sheet1 As Worksheet, sheet2 As Worksheet
Dim data As Variant, i As Long, rownumber As Long, rng As Range
Set actWork = ActiveWorkbook
Set sheet1 = actWork.Sheets("Sheet1")
Set sheet2 = actWork.Sheets("Sheet2")
actWork.Activate
idForSearch = shee2.Range("B5").Value
data = sheet1.Range("B5:B7").Value 'not necessary to be activated
For i = 1 To UBound(data) 'in VBA such an array (created from a range) is 1 based...
If UCase(data(i,1)) = UCase(idForSearch) Then 'VBA is case sensitive
WriteLog i 'you must have a function ('WriteLog') able to do it...
rownumber = i
'if you have only one occurrence, it is good to exit the loop to save time (not for this specific case of 3 times):
Exit For
'If many occurrences may be, you just comment the line above...
End If
Next i
sheet1.Activate 'not necessary
Set rng = sheet1.Range("A" & rownumber & ":" & "C" & rownumber).Select
sheet2.Range("B5:B7").Value = WorksheetFunction.Transpose(rng.Value)
End Sub
The last to code rows transpose the horizontal range of sheet1 on column range of sheet2...
I can help you in function WriteLog creation, if you tell me some more details: What type of log must it be (a text file), on that path to be created, found etc. Do you want to add, append the i value, or would you like to rewrite the existing one if any value already has been recorded?
i have a problem with my macro. I know its alot of code (sry for that) but i think it could be helpfull. So the basic thing i want to do is, take the value of the combobox and search for it in another worksheet to get the price written in the next column.
easy so far, but the name im searching for is not unique in the database. the one im searching for is only defined by beeing part of the correct named range (i.e. EngineMercedesDiesel)
Function getprice(Matrix As Range, name As String)
Dim i As Integer
Dim row As Variant
Dim col As Variant
Dim price As Variant
'loop to finde inside the range the name im looking for
For i = 1 To Matrix.Rows.Count
If Matrix.Cells(i, 1).Value = name Then
row = Matrix.Cells(i, 1).Address(RowAbsolute:=True)
col = Matrix.Cells(i, 1).Address(ColumnAbsolute:=True)
price = Tabelle2.Cells(row, col + 1).Value
Exit For
Next
getprice = price
End Function
Private Sub cbschaltung_Change()
Dim go As Range
Dim handle As String
'from here it builds the name i.e. EngineMercedesDiesel an there is a Named range with the same titel outside VBA
teil = Range("A4").Value
hersteller = Range("B3").Value
handle = cbschaltung.Value
If checkboxel.Value = True Then
c = checkboxel.Caption
Set go = teil & hersteller & c 'storing to the variable go, here ocures the error
Tabelle3.Range("C4").Value = getprice(go, handle)
ElseIf checkboxmech.Value = True Then
c = checkboxmech.Caption
Set go = teil & hersteller & c
Tabelle3.Range("C4").Value = getprice(go, handle)
End If
End Sub
I hop you can help me and (hopefully) you have a easy answer for me
ok i did it finally !
ElseIf checkboxmech.Value = True Then
c = checkboxmech.Caption
mname = teil & hersteller & c
Set go = Worksheets("Gruppendatenbank").Range(mname)
Tabelle3.Range("C4").Value = getprice(go, handle)
it was immportant to define mname as variant datatype and define also the worksheet of my range.
thank for the help
statusupdate: solved !
I have a little experience with VBA, and I would really appreciate any help with this issue. In a basic sense, I need to convert 2 columns of data in sheet 1 to rows of data in sheet 2.
It currently looks like this in Excel:
And I need it to look like this:
I've already written the code to transfer the headings over to sheet 2, and it works fine. I'm just having issues with transferring the actual values in the correct format. Right now, the body of my code is
ws.Range("B3").Copy
ws2.Range("C2").PasteSpecial xlPasteValues
ws.Range("B4").Copy
ws2.Range("D2").PasteSpecial xlPasteValues
ws.Range("B5").Copy
ws2.Range("E2").PasteSpecial xlPasteValues
ws.Range("B6").Copy
ws2.Range("F2").PasteSpecial xlPasteValues
continued on and on. However, this really won't work, as the actual document I'm working on has tens of thousands of data points. I know there's a way to automate this process, but everything I've tried has either done nothing or given an error 1004.
Any help with this would be greatly appreciated!!
Edit: There are hundreds of little sections of data, each 18 rows long (1 row for the frame #, 1 row for the time, and 1 row for each of the 16 channels). I'm trying to get it into a loop with a step size of 18. Is that possible? I'm fine with loops, but I've never done a loop with copying and pasting cell values
Try this code:
Dim X() As Variant
Dim Y() As Variant
X = ActiveSheet.Range("YourRange").Value
Y = Application.WorksheetFunction.Transpose(X)
Also check out this link: Transpose a range in VBA
This method leverages loops and arrays to transfer the data. It isn't the most dynamic method but it gets the job done. All the loops use existing constants, so if your data set changes you can adjust the constants and it should run just fine. Make sure to adjust the worksheet names to match the names you are using in your excel document. In effect, what this is doing is loading your data into an array and transposing it onto another worksheet.
If your data set sizes change quite a bit, you will want to include some logic to adjust the loop variables and array size declarations. If this is the case, let me know and I'll figure out how to do that and post an edit.
Sub moveTimeData()
Set source = ThisWorkbook.Sheets("RawData")
Set dest = ThisWorkbook.Sheets("TransposeSheet")
Const dataSetSize = 15
Const row15Start = 3
Const row15End = 18
Const row30Start = 21
Const row30End = 36
Const colStart = 2
Const destColStart = 2
Const dest15RowStart = 2
Const dest30RowStart = 3
Dim time15Array() As Integer
Dim time30Array() As Integer
ReDim time15Array(0 To dataSetSize)
ReDim time30Array(0 To dataSetSize)
Dim X As Integer
Dim Y As Integer
Dim c As Integer
c = 0
For X = row15Start To row15End
time15Array(c) = source.Cells(X, colStart).Value
c = c + 1
Next X
c = 0
For X = row30Start To row30End
time30Array(c) = source.Cells(X, colStart).Value
c = c + 1
Next X
For X = 0 To dataSetSize
dest.Cells(dest15RowStart, X + destColStart).Value = time15Array(X)
Next X
For X = 0 To dataSetSize
dest.Cells(dest30RowStart, X + destColStart).Value = time30Array(X)
Next X
End Sub
EDIT-> I think this is what you are looking for after reading your edits
Sub moveTimeData()
Set source = ThisWorkbook.Sheets("RawData")
Set dest = ThisWorkbook.Sheets("TransposeSheet")
Const numberDataGroups = 4
Const dataSetSize = 15
Const stepSize = 18
Const sourceRowStart = 3
Const sourceColStart = 2
Const destColStart = 2
Const destRowStart = 2
Dim X As Integer
Dim Y As Integer
Dim currentRow As Integer
currentRow = destRowStart
For X = 0 To numberDataGroups
For Y = 0 To dataSetSize
dest.Cells(currentRow, Y + destColStart).Value = source.Cells((X * stepSize) + (Y + sourceRowStart), sourceColStart)
Next Y
currentRow = currentRow + 1
Next X
End Sub
Now the key to this working is knowing how many groups of data you are dealing with after the data dump. You either need to include logic for detecting that or adjust the constant called numberDataGroups to reflect how many groups you have. Note: I leveraged a similar technique for traversing arrays that have their data stored in Row Major format.
Use Copy, then Paste Special+Transpose to turn your columns into rows:
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Try this:
Sub TansposeRange()
Dim InRange As Range
Dim OutRange As Range
Dim i As Long
Set InRange = Sheet1.Range("B3:B10002")
Set OutRange = Sheet2.Range("C2")
InRange.Worksheet.Activate
InRange.Select
Selection.Copy
OutRange.Worksheet.Activate
OutRange.Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
End Sub
This is a way to do it using a loop, here illustrated with a step of 2
Notice that you have to specify the OutRange precisely the correct size (here NTR2 is the 10001's cell of the 2nd row).
Sub TansposeRange()
Dim InRange As Range
Dim OutRange As Range
Dim i As Long
Set InRange = Sheet1.Range("B3:B10002")
Set OutRange = Sheet2.Range("C2:NTR2")
For i = 1 To 10000 Step 2
OutRange.Cells(1, i) = InRange.Cells(i, 1)
Next i
End Sub
'The following code is working OK
Sub TansposeRange()
'
' Transpose Macro
'
Dim wSht1 As Worksheet
Dim rng1 As Range
Dim straddress As String
Set wSht1 = ActiveSheet
On Error Resume Next
Set rng1 = Application.InputBox(Prompt:="Select Columns or Rows to transpose", _
Title:="TRANSPOSE", Type:=8)
If rng1 Is Nothing Then
MsgBox ("User cancelled!")
Exit Sub
End If
straddress = InputBox(Prompt:="Full cell Address as Sheet2!A1", _
Title:="ENTER Full Address", Default:="Sheet1!A1")
If straddress = vbNullString Then
MsgBox ("User cancelled!")
Exit Sub
End If
Application.ScreenUpdating = False
rng1.Select
rng1.Copy
On Error GoTo 0
'MsgBox straddress
Range(straddress).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.ScreenUpdating = True
End Sub
I am trying to insert a list of selected checkboxes into a spreadsheet, within this use case, a user can choose up to 15 items. This will be inserted into a certain cell which I have defined below.
I have a checkbox with the following names/values:
Name Value
========== =====
chk_week1 1
chk_week2 2
... ...
... ...
chk_week15 15
For example if the user selects chk_week1, chk_week2, chk_week4 and chk_week5, then it should be inserted into the cell as 1,2,4,5.
I've included an image how it looks like to better demonstrate it:
Each checkbox has the name and value listed in the table above. Here is the code I am using so far:
Private Sub btnSubmit_Click()
Dim ws As Worksheet
Dim rng1 As Range
Set ws = Worksheets("main")
' Copy the data to the database
' Get last empty cell in column A
Set rng1 = ws.Cells(Rows.Count, "a").End(xlUp)
' Having difficulty adding the code here
' rng1.Offset(1, 7) = weeks
End Sub
Thanks in advance.
This function would return the string you're wanting to put in the cell.
Function CheckBoxValues() As String
For x = 1 To 15
If Sheets("Main").Shapes("chk_week" & x).OLEFormat.Object.Object.Value Then
CheckBoxValues = CheckBoxValues & x & ","
End If
Next
if Len(CheckBoxValue <> 0) then
CheckBoxValues = Left(CheckBoxValues, Len(CheckBoxValues) - 1)
end if
End Function
Or for the non-looping method, check Francis Dean's solution.
You can use a function to go through your check boxes and return a string in your desired format as such (add on the rest of the check boxes!)
Private Sub btnSubmit_Click()
Dim ws As Worksheet
Dim rng1 As Range
Set ws = Worksheets("main")
' Copy the data to the database
' Get last empty cell in column A
Set rng1 = ws.Cells(Rows.Count, "a").End(xlUp)
' Having difficulty adding the code here
rng1.Offset(1, 7) = GetWeeks
End Sub
Private Function GetWeeks() As String
Dim weeks As String
'Add values to the string if condition is true
If chk_week1.Value = True Then weeks = weeks & "1,"
If chk_week2.Value = True Then weeks = weeks & "2,"
If chk_week3.Value = True Then weeks = weeks & "2,"
'...
If chk_week14.Value = True Then weeks = weeks & "14,"
If chk_week15.Value = True Then weeks = weeks & "15,"
'Remove the trailing comma
If Right(weeks, 1) = "," Then weeks = Left(weeks, Len(weeks) - 1)
GetWeeks = weeks
End Function