search and update into a single cell

Question

I am new to VBA excel, a week old. I have little knowledge in C , with that I have created a program.

The task is that "to search a particluar Number in one excel worksheet(1) and compare in another worksheet(2), get the corrosponding coloumn data , concatinate the information into once cell on Worksheet(1) .

I tried but I can't get the process done I need a valuable suggestion how to fix my code.

My code:

Sub test1()
Dim iComp
Worksheets("BSM_STF_iO").Select
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow

      a = onlyDigits(Range("A" & i).Value)
       If InStr(a, "T") Then
       Else

     Worksheets("Tabelle1").Select
        destlastrow = Range("B" & Rows.Count).End(xlUp).Row
        For j = 2 To destlastrow
         b = onlyDigits(Range("B" & j).Value)
          iComp = StrComp(a, b, vbBinaryCompare)
        Select Case iComp
       Case 0
Sheets("Tabelle1").Range(Sheets("Tabelle1").Cells(j, 3), Sheets("Tabelle1").Cells(j, 4)).Copy
Sheets("Tabelle1").Activate
erow = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Sheets("Tabelle1").Range(Cells(erow, 8), Cells(erow, 9))
Sheets("BSM_STF_iO").Activate
End Select
        Next j


    End If

Next i
End Sub
Function onlyDigits(s As String) As String
    Dim retval As String
    Dim i As Integer
    retval = ""
              retval = s
      onlyDigits = retval
End Function

Example:

I need to put all the information from "tabelle1" worksheet information of "10000" to "BSM_STF_io" 10000.

BSM_STF_io
Tabellle1

I recommend reading through [How to avoid `.Select`/`.Activate`](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) as using them can cause some unexpected behavior. Does you code currently give any errors? What doesn't it do that you need? — BruceWayne, Apr 08 '16 at 13:28
Possible duplicate of [Single function to write for all message id](http://stackoverflow.com/questions/36469469/single-function-to-write-for-all-message-id) — Karthick Gunasekaran, Apr 08 '16 at 14:49

score 0 · Accepted Answer · answered Apr 08 '16 at 14:12

See if this helps (I removed the .Activate/.Select parts):

Sub test1()
Dim iComp
Dim bsmWS As Worksheet, tabWS As Worksheet

Set bsmWS = Sheets("BSM_STF_iO")
Set tabWS = Sheets("Tabelle1")

LastRow = bsmWS.Range("A" & bsmWS.Rows.Count).End(xlUp).Row
For i = 2 To LastRow
    a = onlyDigits(bsmWS.Range("A" & i).Value)
    If InStr(a, "T") Then
    ' do something?
    Else
        destlastrow = tabWS.Range("B" & tabWS.Rows.Count).End(xlUp).Row
        For j = 2 To destlastrow
            b = onlyDigits(tabWS.Range("B" & j).Value)
            iComp = StrComp(a, b, vbBinaryCompare)
            Select Case iComp
            Case 0
                With tabWS
                    erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                    .Range(.Cells(j, 3), .Cells(j, 4)).Copy .Range(.Cells(erow, 8), .Cells(erow, 9))
                End With     'tabWS
            End Select
        Next j
    End If

Next i
End Sub

In your original code, sometimes you correctly gave the sheets for the range, but other times not (you should use Sheets("whatever").Rows.Count too). This will hopefully tighten it up and work for you.

ya code is clear thanks, how to paste "tabWs" in incremented couloumns and take that value into concatenate to "Bsm_Stm_io" in B3 row for only ID "10000" — user2965711, Apr 08 '16 at 14:24

search and update into a single cell

1 Answers1