I need some help in writing a code in VBA. I thought I had a pretty good grasp of it, but apparently not.
I have two worksheets in a workbook, "Data" and "Results". "Data" has contents in E2 through E580, but this could change +/-. "Results" has contents in C10 that needs to be copied into D2 and down the column, but only if there is contents in "Data" (E2:E580). Here is what I have so far:
Worksheets("Data").If (Range("E2:E580") = " ", Copy.Worksheets("Results").Range("C10") AND Paste.Worksheets("Data").Range("D2:D580"), False)
Getting Compile Error:
Expected =
Thanks for your help in advance.
Sub copy_data()
Dim i As Integer
For i = 2 To Sheets("Data").Cells(Rows.Count, "E").End(xlUp).Row
If Sheets("Data").Cells(i, 5) <> "" Then
Sheets("Results").Cells(i, 4) = Sheets("Results").Range("C10")
Else
Sheets("Results").Cells(i, 4) = ""
End If
Next i
End Sub
Explanation: Loop through column E in "Data" down to the last entry and copy content from C10 in "Results" into column D if there is a value in the corresponding cell in "Data". If there is no value enter an empty string
Related
I want to create an IF condition using the RIGHT function. It would look up the 4 last digits within a cell and compare it to another cell, then perform actions if it's a match.
Here's a simplified version of the code I toyed with. The action to be performed in this experience is just to display the counter in a cell.
Public vCounter
Sub Counter()
vCounter = 0
Sheets.Add.Name = "Test"
'The cells the RIGHT function will operate from (A1, A2 and A3)
Sheets("Test").Range("A1") = "123"
Sheets("Test").Range("A2") = "456"
Sheets("Test").Range("A3") = "789"
'The cells the result of the RIGHT function will be compared to (B1, B2 and B3)
Sheets("Test").Range("B1") = "23"
Sheets("Test").Range("B2") = "456"
Sheets("Test").Range("B3") = "89"
'This cell (G3) shows the result of a RIGHT function, considering the
'last two digits in A1, as an experience; it works.
Sheets("Test").Range("G3") = Right(Sheets("Test").Cells(1, 1), 2)
For i = 1 To 3
'The RIGHT function considers the two last digits of, successively,
'A1, A2 and A3, and those are compared to, respectively,
'B1, B2 and B3. For some reason, it doesn't work here.
If Right(Sheets("Test").Cells(i, 1), 2) = Sheets("Test").Cells(i, 2) Then
vCounter = vCounter + 1
End If
Next i
'This cell (E3) shows the counter, to test whether or not the If
'condition with the RIGHT function works. By changing the contents
'of the cells I compare between each other, I can check whether or
'not it counts correctly.
Sheets("Test").Range("E3") = vCounter
End Sub
Here's what I get:
The sheet that I get when I run this procedure
In conclusion, in this experience, the RIGHT function somehow doesn't work since the vCounter doesn't get to 2. It stays at 0, showing it doesn't count at all. I deduce from this result that the problem resides in the IF statement containing the RIGHT function. Maybe the For Loop has to do with it, but I doubt it.
Any thoughts?
Even though you're writing string values to your sheet, Excel will automatically assume them to be numeric values, so when you read them back you will be getting values of type Variant/Double.
If you pass one of those Doubles through Right() though, it will return a Variant\String, and it's that comparison between Variant\String and Variant\Double which seems to be failing.
Some test code:
Sub Tester()
Dim ws As Worksheet, v As Variant
Set ws = ThisWorkbook.Worksheets("Test")
ws.Range("A1").Value = "123"
ws.Range("B1").Value = "23"
'Comparing values...
Debug.Print Right(ws.Range("A1").Value, 2) = ws.Range("B1").Value '>> False (Variant\String vs Variant\Double)
Debug.Print Right(ws.Range("A1").Value, 2) = CStr(ws.Range("B1")) '>> True (Variant\String vs Variant\String)
End Sub
I'm trying to copy contents from several sheets to a final sheet (let's call it "Report" sheet), where the content of a sheet is copied starting on the first free row after the content of the previous sheet.
I'm using a for cycle to go to each sheet and copy the range that I need and paste it to the Report sheet, but I'm getting:
Run-time error 1004: "Application-defined or object-defined error"
I already tried changing how to copy/paste the contents, but it still didn't work (copy and paste special; destination range.value = source range.value; select; ...).
Do you have an idea of what's going on?
Thanks in advance for your help!
Sub final_data()
Dim list_end, last_line, h, first_line_range, last_line_range As Integer
Dim sht_qty As Integer
h = 1
i = 2
list_end = 1
sht_qty = Application.Sheets.Count
For h = 1 To sht_qty
If Workbooks("Testes2").Sheets(h).Name <> "Report" Then
last_line = Workbooks("Testes2").Sheets(h).Range("A1").End(xlDown).Row
first_line_range = list_end + 1
last_line_range = last_line + list_end - 1
'the error is on the next line
Workbooks("Testes2").Sheets(h).Range("A2:I" & last_line).Copy Destination:=Workbooks("Testes2").Sheets("Report").Range("A" & first_line_range & "I" & last_line_range)
Else
End If
Next h
End Sub
Just change your destination to this:
Destination:=Workbooks("Testes2").Sheets("Report").Range("A" & first_line_range)
and that should work
Does anyone have an idea how to write VBA in Excel to export multiple rows to just one column. Additionally, I would like to add "enter" at the end of each "row". Ideally, this would be exported in .txt, but it would be already great even if it is converted inside the same document.
Thank you!
Edit: For example: I have rows which contain some text/value A1:A5, B1:B5, ... I would need all of These rows to get "moved" in a single column D for instance. So, A1 would go to D1,A2-D2, A3-D3 ... B1 to D7 and so on. After each end (A5, B5, C5,...) I would need an empty cell (when I convert this to .txt it means enter). I hope it is a bit clearer now.
The code below will do what you describe. Use the constants in the beginning to set how many columns and rows that should be moved to one single column, specified by TargetColNo. An empty cell will be added after each scanned column.
If you prefer to save it to a textfile you can use this code and add a text file to add the result in instead of a column.
Sub Rows2OneColumn()
Const StartColumnNo = 1 ' Start at column A
Const EndColNo = 3 ' End at column C
Const StartRowNo = 1 ' Start at row 1
Const EndRowNo = 5 ' End at row 5
Const TargetColNo = 5 ' Put result in column E
Dim source_row As Integer
Dim source_col As Integer
Dim target_row As Integer
target_row = 1
For source_col = StartColumnNo To EndColNo
For source_row = StartRowNo To EndRowNo
Cells(target_row, TargetColNo).Value = Cells(source_row, source_col).Value
target_row = target_row + 1
Next
target_row = target_row + 1 ' leave one cell empty
Next
End Sub
you need add reference Microsoft ActiveX Data Objects 2.8 Library
Set ff = CreateObject("ADODB.Stream")
ff.Type = 2
ff.Charset = "utf-8"
ff.Open
For Each Cell In Range("A1:D5").Cells
ff.WriteText Cell.Value & vbNewLine
Next
path_to_save = ActiveWorkbook.Path
ff.SaveToFile path_to_save & "\test.txt", 2
I am trying to create a function or functions that can sum daily hours from time cards for each client to come up with the total hours worked per day. Each client has it's own sheet inside of a single workbook.
Currently, I have a function that determines the sheet that goes with the first client (the third sheet in the workbook):
Function FirstSheet()
Application.Volatile
FirstSheet = Sheets(3).Name
End Function
And one to find the last sheet:
Function LastSheet()
Application.Volatile
LastSheet = Sheets(Sheets.Count).Name
End Function
The part that I am having trouble with it getting these to work within the sum function.
=sum(FirstSheet():LastSheet()!A1
That is basically what I want to accomplish. I think the problem is that I don't know how to concatenate it without turning it into a string and it doesn't realize that it is sheet and cell references.
Any help would be greatly appreciated.
So, an example formula would look like this:
=SUM(Sheet2!A1:A5,Sheet3!A1:A5,Sheet4!A1:A5)
That would sum Sheet2-Sheet4, A1:A5 on all sheets.
Is there a reason you need to write the VBA code to do this?
Can't you just enter it as a formula once?
Also, if you're going to the trouble of writing VBA to generate a formula, it may make more sense to just do the sum entirely in VBA code.
If not, try this:
Sub GenerateTheFormula()
Dim x, Formula
Formula = "=SUM(" 'Formula begins with =SUM(
For x = 3 To Sheets.Count
Formula = Formula & Sheets(x).Name & "!A1," 'Add SheetName and Cell and Comma
Next x
Formula = Left(Formula, Len(Formula) - 1) & ")" 'Remove trailing comma and add parenthesis
Range("B1").Formula = Formula 'Where do you want to put this formula?
End Sub
Results:
The functions return strings and not actual worksheets. The Worksheet does not parse strings well. So add a third function that uses the Evaluate function:
Function MySum(rng As Range)
MySum = Application.Caller.Parent.Evaluate("SUM(" & FirstSheet & ":" & LastSheet & "!" & rng.Address & ")")
End Function
Then you would simply call it: MySum(A1)
It uses the other two function you already have created to create a string that can be evaluated as a formula.
I didn't understand ur question completely but As I understood u have different sheets of different clients which contains supoose column 1 date and column 2
contains hours on that particular date wise hours and a final sheet which column1 contains name of client and column 2 contains total hoursPlease try it
Sub countHours()
Dim last_Row As Integer
Dim sum As Double
sum = 0
'Because I know number of client
For i = 1 To 2 'i shows client particular sheet
last_Row = Range("A" & Rows.Count).End(xlUp).Row
Sheets(i).Activate
For j = 2 To last_Row
'In my Excel sheet column 1 contains dates and column 2 contains number of hours
sum = sum + Cells(j, 2)
'MsgBox sum
Next j
'Sheet 3 is my final sheet
ThisWorkbook.Sheets(3).Cells(i + 1, 2).Value = sum
sum = 0
Next i
End Sub
Happy Coding :
I have a simple table where I want to search column A for a value via A1:A10.
When it finds a value it should copy/paste it to the correspond ending cell in column B.
-Moreover it would be nice to search for multiple values like
"value1 value2 value3 and to copy all found values in A to B.
The output should be:
And for multiple values:
EDIT:
I had to replace the functions with german, but it won't work for me.
For B2 I added: =GLÄTTEN(VERKETTEN(D2;" ";E2;" ";F2;" ";G2))
For C2 I added: =GLÄTTEN(VERKETTEN(B2;" ";D2;" ";E2;" ";F2;" ";G2))
For C10 I added: =GLÄTTEN(LINKS(B10;FINDEN(" ";B10)))
For D10 I added: =GLÄTTEN(LINKS(B11;FINDEN(" ";B11)))
For E10 I added: =GLÄTTEN(LINKS(B12;FINDEN(" ";B12)))
For F10 I added: =GLÄTTEN(B13)
For B11 I added: =TEIL(B10;LÄNGE(C10)+2;99)
For B12 I added: =TEIL(B11;LÄNGE(D10)+2;99)
For B13 I added: =TEIL(B12;LÄNGE(E10)+2;99)
The translation I got from here.
You can do it efficiently in VBA as below
Hit Alt and F11 to open the Visual Basic Editor (VBE).
From the menu, choose Insert-Module.
copy and paste the code into the code window at right.
Hit Alt and F11 to return to Excel
run the macro from the Developer tab for Excel 2007 and higher, for Excel 2003 use ...Tools-Macro-Macros
enter code here
Sub QuickFInd()
Dim X As Variant
Dim Y As Variant
Dim vWords As Variant
Dim Vword As Variant
Dim lngCnt As Long
X = Range("A2:A8").Value2
ReDim Y(1 To UBound(X), 1 To 1)
vWords = Split([b10].Value)
For lngCnt = 1 To UBound(X)
For Each Vword In vWords
If InStr(X(lngCnt, 1), Vword) > 0 Then Y(lngCnt, 1) = Y(lngCnt, 1) & Vword & Chr(32)
Next Vword
Next
[b2].Resize(UBound(Y), 1).Value2 = Y
End Sub
I've solved your problem with VBA code. To use it, create a VBA module in the excel workbook and paste the following code in. Then go back to the worksheet you want it to run on, and click "Macros" and select "Search".
Let me know how it works ~
Example:
Code:
Public Sub search()
'Enter the location of your "Key Word" cell here (where you want the search values to come from)
Dim KeyCell As String: KeyCell = "B11"
'Enter the range you would like to search here
Dim searchRange As Range: Set searchRange = ActiveSheet.Range("A2", "A11")
'Enter the column you want to print to
Dim printColumn As String: printColumn = "B"
'##### the real program starts here ####
'create an array of values that we will search for
Dim values() As String
'each item in the values array is separated by a space in the "Key Word" cell
values = Split(CStr(ActiveSheet.Range(KeyCell).Value), " ")
Dim dataCell As Object
'now we loop through each cell in the search range
For Each dataCell In searchRange
'loop through each value in our array of values
For Each v In values
'check to see if our value is in the cell we are searching
If InStr(1, CStr(dataCell.Value), CStr(v), vbBinaryCompare) > 0 Then
'print
With ActiveSheet.Range(printColumn & dataCell.Row)
.Value = .Value & " " & CStr(v)
End With
End If
Next v
Next dataCell
End Sub
If you want only a search without PASTE or VBA, you can follow the scheme:
and add formula:
B2 -> =TRIM(CONCATENATE(D2;" ";E2;" ";F2;" ";G2))
C2 -> =IF(IFERROR(FIND(C$10;$A2)>0;"")=TRUE;C$10;"") and autocomplete
C10 -> =TRIM(LEFT(B10;IFERROR(FIND(" ";B10);99))) CORRECT !
D10 -> =TRIM(LEFT(B11;IFERROR(FIND(" ";B11);99))) CORRECT !
E10 -> =TRIM(LEFT(B12;IFERROR(FIND(" ";B12);99))) CORRECT !
F10 -> =TRIM(B13)
B11 -> =MID(B10;LEN(C10)+2;99)
B12 -> =MID(B11;LEN(D10)+2;99)
B13 -> =MID(B12;LEN(E10)+2;99)
Hiding the Support Formula Columns. You can add how many words you want... obviusly adding other formulas.
If you need to add phisically the values, you can add a column between A & B and copy and paste with value the moved column "C" (Ex B). Modify the C2 formula in:
=TRIM(CONCATENATE(B2;" ";D2;" ";E2;" ";F2;" ";G2)) and autocomplete...
This formulas add the keys already saved... (No duplicate check).
I have correct the formula... Previously work only with 4 key...
You could do something like this:
=IF(IFERROR(FIND($B$10,A2,1),0)>0,$B$10&" ","")&IF(IFERROR(FIND($B$11,A2,1),0)>0,$B$11&" ","")&IF(IFERROR(FIND($B$12,A2,1),0)>0,$B$12&" ","")
And just auto-fill that down for all your text items.