Add 1 do previous cell if cell X has value / export value to another Workbook

[faffol]

Hi everybody,
I have a problem, situation is like this:

I have 2 worbooks. In workbook 1, I write all the data, I made a button/macro so if i click it it transfer data to Workbook 2.sheets1 to first empty row.

1Question) If i transfer data to 1st empy row in WB2 (it starting in row 3 and go for columns from D:BE) I want in that row, culumn A to appear the index number, I made it with excel formula i put in A3=if(is.text(D2);"1";"") and in A4=if(is.text(d3);A3+1;"" and i can copy it to do it forever till A65000 of whatever. How to make macro like that instead of formula?

2Question) After I click the macro button it do a fallows: transfer data do Workbook 2-->clear data in WB (so i can write new ones).
I want to add formula that transfer data do Workbook 2-->clear data in WB---->from Workbook2.sheets1.range(last row with value) this value and transfer it to Workbook1.sheets1.("$C$3") <-- always to C3 whether it transfer it from WB2.sheets1.range("A4") or A65000.

Many thanks in advance! btw. the transfer macro i have made because of help in this forum!

[JBeaucaire]

1) enter a new value in a column that is +1 higher than the current highest value in that column

Dim SerialNum as Long, NR as Long

With Workbooks("Workbook2.xls").Sheets("Sheet1")
    SerialNum = Worksheetfunction.Max(.Range("A:A")) + 1
    NR = .Range("D" & .Rows.Count).End(xlUp).Row + 1

    .Range("A" & NR).Value = SerialNum
    .Range("D" & NR).Value = (some value from my first workbook)

End With

2) I got lost reading #2. Can you clarify what you're doing there again?

[faffol]

Thank You for the response

I will try to clarify

I have got 2 Workbooks (WB1 and WB2)

In WB1 there is already a macro attached to a button. If i clink on it, it transfer data from WB1.sheets1.range("c3:c55") to the WB2.sheets2.range("d[x]:be"). [x] is the first empty row. After it it clear the data from WB1.sheets1.range("c3:c55"). So WB1 is to fill form and after i transfer data to WB2, it clears WB1 again so I can fill another form. Data are transfered to WB2 so I can record of all forms filled.

In attachement I added simplification. sheets are workbooks, what I do:
1)WB1 type name/surname/address/phone
2)Click on "button". The button has macro to transfer data to WB2 and then clear WB1 b3:b6 cell content
3) in WB2 I want the macro that: if B2 is text then a2=1. If b2 is text then a3=a2+1 ...... and so on
What i want to do is to add macro lines that will 2)* after transfer and clear content it takes last row, A column numer from WB2 and transfer it to the WB1. A2. So I have cleared form with next number on it to fill.

Hope It was more clear. Advance thanks for Your effort.

[JBeaucaire]

The SerialNumber trick I suggested will work for that, I'd imagine. That shows how to spot the highest current value in columnA of WB2, add one and store it in a variable. Then you can use that number as you wish. I've shown one way to use it. You could choose instead to bring that value back to WB1 and place that value in a cell.

[faffol]

Hi JBeaucaire
I am a not experienced with using variables unfortunately. I would be very grateful if you could explain with more vba code.
1)the code you posted will add index number (column A) if in same row column (column B) is text, right? - this code will be in Workbook2.sheets1 objects
2)This number should be copied (transfered) to Workbook1.sheets1.range("c3")? -this code will be added to workbook1.sheets1 objects

Advance thanks for help!

[faffol]

This is my code, as You can see I am not good with variables

Sub TransferData()
    Dim wkb As Workbook, wks As Worksheet, LastRow As Long
    Dim FilePath As String, FileName As String
    Dim ws As Worksheet, blnOpened As Boolean
    'Change these variables as desired...
    FilePath = "address" 'change path here
    FileName = "name of the file" 'change name here
    Call ToggleEvents(False)
    Set ws = ThisWorkbook.Sheets("input sheet") 'change source sheet name here
    If WbOpen(FileName) = True Then
        Set wkb = Workbooks(FileName)
        blnOpened = False
    Else
        If Right(FilePath, 1) <> Application.PathSeparator Then
            FilePath = FilePath & Application.PathSeparator
        End If
        Set wkb = Workbooks.Open(FilePath & FileName)
        blnOpened = True
    End If
    Set wks = wkb.Sheets("master data") 'change destination sheet name here
    LastRow = wks.Cells.Find(what:="*", after:=wks.Cells(1, 1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
    wks.Cells(LastRow, "B").Value = ws.Cells(3, "c").Value
wks.Cells(LastRow, "C").Value = ws.Cells(4, "c").Value
wks.Cells(LastRow, "D").Value = ws.Cells(5, "c").Value
wks.Cells(LastRow, "E").Value = ws.Cells(6, "c").Value
wks.Cells(LastRow, "F").Value = ws.Cells(7, "c").Value
wks.Cells(LastRow, "G").Value = ws.Cells(8, "c").Value
wks.Cells(LastRow, "H").Value = ws.Cells(9, "c").Value
wks.Cells(LastRow, "I").Value = ws.Cells(10, "c").Value
wks.Cells(LastRow, "J").Value = ws.Cells(11, "c").Value
wks.Cells(LastRow, "K").Value = ws.Cells(12, "c").Value
wks.Cells(LastRow, "L").Value = ws.Cells(13, "c").Value
wks.Cells(LastRow, "M").Value = ws.Cells(14, "c").Value
wks.Cells(LastRow, "N").Value = ws.Cells(15, "c").Value
wks.Cells(LastRow, "O").Value = ws.Cells(16, "c").Value
wks.Cells(LastRow, "P").Value = ws.Cells(17, "c").Value
wks.Cells(LastRow, "Q").Value = ws.Cells(18, "c").Value
wks.Cells(LastRow, "R").Value = ws.Cells(19, "c").Value
wks.Cells(LastRow, "S").Value = ws.Cells(20, "c").Value
wks.Cells(LastRow, "T").Value = ws.Cells(21, "c").Value
wks.Cells(LastRow, "U").Value = ws.Cells(22, "c").Value
wks.Cells(LastRow, "V").Value = ws.Cells(23, "c").Value
wks.Cells(LastRow, "W").Value = ws.Cells(24, "c").Value
wks.Cells(LastRow, "X").Value = ws.Cells(25, "c").Value
wks.Cells(LastRow, "Y").Value = ws.Cells(26, "c").Value
wks.Cells(LastRow, "Z").Value = ws.Cells(27, "c").Value
wks.Cells(LastRow, "aa").Value = ws.Cells(28, "c").Value
wks.Cells(LastRow, "aB").Value = ws.Cells(29, "c").Value
wks.Cells(LastRow, "aC").Value = ws.Cells(30, "c").Value
wks.Cells(LastRow, "aD").Value = ws.Cells(31, "c").Value
wks.Cells(LastRow, "aE").Value = ws.Cells(32, "c").Value
wks.Cells(LastRow, "aF").Value = ws.Cells(33, "c").Value
wks.Cells(LastRow, "aG").Value = ws.Cells(34, "c").Value
wks.Cells(LastRow, "aH").Value = ws.Cells(35, "c").Value
wks.Cells(LastRow, "aI").Value = ws.Cells(36, "c").Value
wks.Cells(LastRow, "aJ").Value = ws.Cells(37, "c").Value
wks.Cells(LastRow, "aK").Value = ws.Cells(38, "c").Value
wks.Cells(LastRow, "aL").Value = ws.Cells(39, "c").Value
wks.Cells(LastRow, "aM").Value = ws.Cells(40, "c").Value
wks.Cells(LastRow, "aN").Value = ws.Cells(41, "c").Value
wks.Cells(LastRow, "aO").Value = ws.Cells(42, "c").Value
wks.Cells(LastRow, "aP").Value = ws.Cells(43, "c").Value
wks.Cells(LastRow, "aQ").Value = ws.Cells(44, "c").Value
wks.Cells(LastRow, "aR").Value = ws.Cells(45, "c").Value
wks.Cells(LastRow, "aS").Value = ws.Cells(46, "c").Value
wks.Cells(LastRow, "aT").Value = ws.Cells(47, "c").Value
wks.Cells(LastRow, "aU").Value = ws.Cells(48, "c").Value
wks.Cells(LastRow, "aV").Value = ws.Cells(49, "c").Value
wks.Cells(LastRow, "aW").Value = ws.Cells(50, "c").Value
wks.Cells(LastRow, "aX").Value = ws.Cells(51, "c").Value
wks.Cells(LastRow, "aY").Value = ws.Cells(52, "c").Value
wks.Cells(LastRow, "aZ").Value = ws.Cells(53, "c").Value
wks.Cells(LastRow, "ba").Value = ws.Cells(54, "c").Value
wks.Cells(LastRow, "bB").Value = ws.Cells(55, "c").Value
wks.Cells(LastRow, "bc").Value = ws.Cells(56, "c").Value
    If blnOpened = True Then
        wkb.Close SaveChanges:=True
    End If
    If MsgBox("Clear values?", vbYesNo, "CLEAR?") = vbYes Then
        Call ClearData
    End If
    Call ToggleEvents(True)
    Sheets(Array("sheet1", "sheet2", "sheet3")).Select
    Sheets("ELV form").Activate
    Application.ActivePrinter = "HP Color LaserJet 4550 PCL6 na Ne05:"
    ExecuteExcel4Macro _
        "PRINT(1,,,1,,,,,,,,2,""HP Color LaserJet 4550 PCL6 na Ne05:"",,TRUE,,FALSE)"
End Sub

Sub ClearData()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("input sheet") 'change as desired
    ws.Range("c3").ClearContents

ws.Range("c5").ClearContents
ws.Range("c6").ClearContents
ws.Range("c7").ClearContents
ws.Range("c8").ClearContents
ws.Range("c9").ClearContents
ws.Range("c10").ClearContents
ws.Range("c11").ClearContents
ws.Range("c12").ClearContents
ws.Range("c13").ClearContents
ws.Range("c14").ClearContents
ws.Range("c15").ClearContents
ws.Range("c16").ClearContents
ws.Range("c17").ClearContents
ws.Range("c18").ClearContents
ws.Range("c19").ClearContents
ws.Range("c20").ClearContents
ws.Range("c21").ClearContents
ws.Range("c22").ClearContents
ws.Range("c23").ClearContents
ws.Range("c24").ClearContents
ws.Range("c25").ClearContents
ws.Range("c26").ClearContents
ws.Range("c27").ClearContents
ws.Range("c28").ClearContents
ws.Range("c29").ClearContents
ws.Range("c30").ClearContents
ws.Range("c31").ClearContents
ws.Range("c32").ClearContents
ws.Range("c33").ClearContents
ws.Range("c34").ClearContents
ws.Range("c35").ClearContents
ws.Range("c36").ClearContents
ws.Range("c37").ClearContents
ws.Range("c38").ClearContents
ws.Range("c39").ClearContents
ws.Range("c40").ClearContents
ws.Range("c41").ClearContents
ws.Range("c42").ClearContents
ws.Range("c43").ClearContents
ws.Range("c44").ClearContents
ws.Range("c45").ClearContents
ws.Range("c46").ClearContents
ws.Range("c47").ClearContents
ws.Range("c48").ClearContents
ws.Range("c49").ClearContents
ws.Range("c50").ClearContents
ws.Range("c51").ClearContents
ws.Range("c52").ClearContents
ws.Range("c53").ClearContents
ws.Range("c54").ClearContents
ws.Range("c55").ClearContents
ws.Range("c56").ClearContents

End Sub

Sub ToggleEvents(blnState As Boolean)
'Originally written by firefytr
    With Application
        .DisplayAlerts = blnState
        .EnableEvents = blnState
        .ScreenUpdating = blnState
        If blnState Then .CutCopyMode = False
        If blnState Then .StatusBar = False
    End With
End Sub

Function WbOpen(wbName As String) As Boolean
'Originally found written by Jake Marx
    On Error Resume Next
    WbOpen = Len(Workbooks(wbName).Name)
End Function

This code is added to a button

I want to add after clear content line code that will:
Take the index number(increased by 1) from workbook2.sheets("master data") last row, and transfer it to WB1( the one where the code is written) to sheets("input sheet").range("c3")

In WB2.sheets("master data") I want to:
Index number in column A will appear when in same row there column D is text (text will be transfered from WB1 "input sheet") and will be +1 than previous index number

[JBeaucaire]

1) you're closing the workbook, so you'll need to do that BEFORE you close the workbook, I'd suggest.

2) You can just copy the existing formula in A2 down into the newly added LastRow. You have to do this before you close the workbook.



Streamlined code:

Option Explicit

Sub TransferData()
Dim wkb As Workbook, wks As Worksheet, LastRow As Long
Dim FilePath As String, FName As String
Dim ws As Worksheet, blnOpened As Boolean               'Change these variables as desired...
    
FilePath = "address"                                    'change path here (this isn't a real path yet)
FName = "name of the file"                              'change name here
    
    Call ToggleEvents(False)
    Set ws = ThisWorkbook.Sheets("input sheet")         'change source sheet name here
    If WbOpen(FName) = True Then
        Set wkb = Workbooks(FName)
        blnOpened = False
    Else
        If Right(FilePath, 1) <> Application.PathSeparator Then
            FilePath = FilePath & Application.PathSeparator
        End If
        Set wkb = Workbooks.Open(FilePath & FName)
        blnOpened = True
    End If
    
    Set wks = wkb.Sheets("master data")                 'change destination sheet name here
    LastRow = wks.Cells.Find(what:="*", After:=wks.Cells(1, 1), _
        Searchorder:=xlByRows, Searchdirection:=xlPrevious).Row + 1
    
    ws.Range("C3:C56").Copy
    wks.Range("B" & LastRow).PasteSpecial xlPasteValues, Transpose:=True
    wks.Range("A" & LastRow).Formula = wks.Range("A2").Formula
    ws.Range("C3").Value = wks.Range("A" & LastRow).Value    
    If MsgBox("Clear values?", vbYesNo, "CLEAR?") = vbYes Then Call ClearData
    If blnOpened = True Then wkb.Close SaveChanges:=True

    Call ToggleEvents(True)
    Sheets(Array("sheet1", "sheet2", "sheet3")).Select
    Sheets("ELV form").Activate
    Application.ActivePrinter = "HP Color LaserJet 4550 PCL6 na Ne05:"
    ExecuteExcel4Macro _
        "PRINT(1,,,1,,,,,,,,2,""HP Color LaserJet 4550 PCL6 na Ne05:"",,TRUE,,FALSE)"
End Sub

Sub ClearData()
Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Sheets("input sheet") 'change as desired
    ws.Range("C3, C5:C56").ClearContents

End Sub

Sub ToggleEvents(blnState As Boolean)
'Originally written by firefytr
    With Application
        .DisplayAlerts = blnState
        .EnableEvents = blnState
        .ScreenUpdating = blnState
        If blnState Then .CutCopyMode = False
        If blnState Then .StatusBar = False
    End With
End Sub

Function WbOpen(wbName As String) As Boolean
'Originally found written by Jake Marx
    On Error Resume Next
    WbOpen = Len(Workbooks(wbName).Name)
End Function

[faffol]

JBeaucaire THANKS a lot!!!