VBA code for adding data from a sheet to another

**Atlantis764** · 03-07-2023, 05:19 PM

**DocAElstein** · 03-08-2023, 04:38 AM

Hi Liviu
This is fairly easy with VBA.
Excel itself is not much more than a lot of VBA coding that automatically does things when you type stuff.

In VBA we have 2 sorts of possibilities to do coding to do stuff
Either
_ (i) we can write a macro from scratch and then run it ourselves when we want to. Those complete macros we put typically in a normal code module. We make those code modules as we need them
or
_ (ii) we can add some more coding into the existing coding written by Microsoft which automatically run when something is done. ( Often here we talk about Event Coding ). Microsoft have alredy put those code modules in.

Microsoft don’t usually let us look at the macros they wrote to make Excel work, but they do give us a way to add coding in the same place, so that way it can also be run when something is done.

so, we want to tap into the coding that runs when something is done in worksheet database. There are a few such macros. As an initial attempt, I will try the one which runs when something is changed in worksheet database.
Here is one way to get at it:

_ First, right click on the tab and select View Code :

_ Then fiddle around with both of the two drop down lists until you get the coding to do with worksheet change :

It’s this one

Code:

Private Sub Worksheet_Change(ByVal Target As Range)



End Sub

You don’t see all the coding that is already there because Microsoft don’t want us to and so they have made it invisible. That does not worry us. We just add our coding in there and it will be done when all the other stuff is done by Microsoft when you change anything in a worksheet, (specifically worksheet database in this case)
After that, its just normally VBA coding stuff

I will help get you started with some coding that runs when you change something in column H (column 8 )

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
' the next few lines arange when excactly our coding is done
    If Target.Cells.Count <> 1 Then Exit Sub ' So I will ignore any multi cell changes
    If Target.Column <> 8 Then Exit Sub      ' So I will ignore any changes not in column H
    ' If we get this far then we changed something in column H (column 8)
Dim WsD1 As Worksheet: Set WsD1 = ThisWorkbook.Worksheets("Database1") ' I need to have some way to tell Excel when i am referring to the other worksheet, or else Excel will by default think I am referencing this workseet

Rem 1 try to match the  name & Activity & Sub-activity
Dim arrD1() As Variant: Let arrD1() = WsD1.Evaluate("=A1:A25 & B1:B25 & C1:C25") ' This is a convenient way to get an array of the three things for all rows
Dim strSrch As String ': Let strSrch = Range("E2").Value & Range("F2").Value & Range("G2").Value ' This gives for example,  "JohnA.1A.1.1"
Dim TgRw As Long: Let TgRw = Target.Row ' the changed target row
 Let strSrch = Range("E" & TgRw & "").Value & Range("F" & TgRw & "").Value & Range("G" & TgRw & "").Value
Dim MtchRw As Long
 Let MtchRw = Application.Match(strSrch, arrD1(), 0) ' this tries to match the correct row in Database1

Rem 2 try now to match the dates
Dim arrDts() As Variant: Let arrDts() = WsD1.Evaluate("=IF({1},A1:K1)")
Dim DteV2 As Long: Let DteV2 = Range("D" & TgRw & "").Value2 '  Value 2 gives us the number used by excel for a date
Dim MtchClm As Long
 Let MtchClm = Application.Match(DteV2, arrDts(), 1) ' this tries to match the correct row in Database1  using a 1 as the third argument im match will get the neartest next date match

Rem 3 use the found row and column to get the final wanted result
 Let WsD1.Cells.Item(MtchRw, MtchClm).Value = Range("H" & TgRw & "").Value

End Sub

**Atlantis764** · 03-08-2023, 01:07 PM

**DocAElstein** · 03-08-2023, 03:43 PM

Originally Posted by Atlantis764

...I hope you don't mind if I bother you again.....

**Atlantis764** · 03-08-2023, 05:34 PM

**DocAElstein** · 03-09-2023, 04:14 AM

Hi,
You got very close. In fact, it's better than that: you do have all the correct coding, It's all just as it should be. You modified the coding perfectly to suit the new requirement.

( You may be getting 5 and 6 a bit mixed up in your testing, but I don’t think that is the main problem )

The main thing you are doing wrong is, I think, as follows
The macro ( event coding ) that runs automatically when something ( anything) changes anywhere in a worksheet is pre made and pre defined by Microsoft and they give it the name Worksheet_Change. So Worksheet_Change is a special unique name. We cannot easily make a second macro to do something when a change is made in a worksheet, and if we did, Excel would probably get very confused and crash.

Any coding you want to do anything when a change occurs in a worksheet must go in that single special macro , Worksheet_Change

So you had all the correct coding. You just need to make a few very minor changes so that you can have it all in that single macro.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
' the next few lines arange when excactly our coding is done
    If Target.Cells.Count <> 1 Then Exit Sub ' So I will ignore any multi cell changes
    If Target.Column < 8 Or Target.Column > 9 Then Exit Sub      ' So I will ignore any changes not in column H or colimn I
Dim TgRw As Long: Let TgRw = Target.Row ' the changed target row
    If Target.Column = 8 Then
        ' If we get this far then we changed something in column H (column 8)
    Dim WsD1 As Worksheet: Set WsD1 = ThisWorkbook.Worksheets("Database1") ' I need to have some way to tell Excel when i am referring to the other worksheet, or else Excel will by default think I am referencing this workseet
    
    Rem 1 try to match the  name & Activity & Sub-activity
    Dim arrD1() As Variant: Let arrD1() = WsD1.Evaluate("=A1:A25 & B1:B25 & C1:C25") ' This is a convenient way to get an array of the three things for all rows
    Dim strSrch As String ': Let strSrch = Range("E2").Value & Range("F2").Value & Range("G2").Value ' This gives for example,  "JohnA.1A.1.1"
    'Dim TgRw As Long: Let TgRw = Target.Row ' the changed target row
     Let strSrch = Range("E" & TgRw & "").Value & Range("F" & TgRw & "").Value & Range("G" & TgRw & "").Value
    Dim MtchRw As Long
     Let MtchRw = Application.Match(strSrch, arrD1(), 0) ' this tries to match the correct row in Database1
    
    Rem 2 try now to match the dates
    Dim arrDts() As Variant: Let arrDts() = WsD1.Evaluate("=IF({1},A1:K1)")
    Dim DteV2 As Long: Let DteV2 = Range("D" & TgRw & "").Value2 '  Value 2 gives us the number used by excel for a date
    Dim MtchClm As Long
     Let MtchClm = Application.Match(DteV2, arrDts(), 1) ' this tries to match the correct row in Database1  using a 1 as the third argument im match will get the neartest next date match
    
    Rem 3 use the found row and column to get the final wanted result
     Let WsD1.Cells.Item(MtchRw, MtchClm).Value = Range("H" & TgRw & "").Value
    Else
    ' If it was not column 8 I changed, then it must have been column 9
    Dim WsD2 As Worksheet: Set WsD2 = ThisWorkbook.Worksheets("Database2") ' I need to have some way to tell Excel when i am referring to the other worksheet, or else Excel will by default thinkk I am referencing this workseet
    
    Rem 1 try to match the  name & Activity & Sub-activity
    Dim arrD2() As Variant: Let arrD2() = WsD2.Evaluate("=A1:A25 & B1:B25 & C1:C25") ' This is a convenient way to get an array of the three things for all rows
    Dim strSrch2 As String: Let strSrch2 = Range("E2").Value & Range("F2").Value & Range("G2").Value  ' This gives for example,  "JohnA.1A.1.1"
    'Dim TgRw As Long: Let TgRw = Target.Row ' the changed target row
     Let strSrch2 = Range("E" & TgRw & "").Value & Range("F" & TgRw & "").Value & Range("G" & TgRw & "").Value
    Dim MtchRw2 As Long
     Let MtchRw2 = Application.Match(strSrch2, arrD2(), 0) ' this tries to match the correct row in Database1
    
    Rem 2 try now to match the dates
    Dim arrDts2() As Variant: Let arrDts2() = WsD2.Evaluate("=IF({1},A1:K1)")
    Dim Dte2V2 As Long: Let Dte2V2 = Range("D" & TgRw & "").Value2 '  Value 2 gives us the number used by excel for a date
    Dim MtchClm2 As Long
     Let MtchClm2 = Application.Match(Dte2V2, arrDts2(), 1) ' this tries to match the correct row in Database2  using a 1 as the third argument im match will get the neartest next date match
    
    Rem 3 use the found row and column to get the final wanted result
     Let WsD2.Cells.Item(MtchRw2, MtchClm2).Value = Range("I" & TgRw & "").Value
    End If
End Sub

**Atlantis764** · 03-09-2023, 01:31 PM

**DocAElstein** · 03-09-2023, 07:14 PM

Hi,

Originally Posted by Atlantis764

..The top row will always be the same and in the same position in Database1 and Database2 and all the columns will be identical.

This means that we don’t need two very similar main sections ( I mean we don’t need two lots of Rem 1 and Rem 2 ) since they are doing the same thing. So it matters not what worksheet we do the matching to, Datebase1 or daterbase2, the results of the found column and row would always be the same. But that is not so bad in this case as the coding works very efficiently and large more laid out coding is often better to understand and modify and learn from – from your attempt its clear your picked up well how to do things.
But the point is that we could then use the main Rem 1 and Rem 2 section once as in the first shorter macro I did for you ( https://excelfox.com/forum/showthrea...ll=1#post19860 )
The modification needed would be 2 main changes to the first shorter macro
_ having a bit from the top of the last macro , ( https://excelfox.com/forum/showthrea...ll=1#post19868 ) , so that it runs when either column H or column I is changed,
_ then the output section Rem 3 would need to be tweaked a bit so that it outputted to the correct stuff to the correct worksheet
Here is a solution like that: ( https://excelfox.com/forum/showthrea...ll=1#post19870 )

Originally Posted by Atlantis764

..Do you think it is possible to help me with this change in the VBA code so that when I delete an amount from one column or another (or the entire row in Database), that amount is also deleted from the related database (hours in Database1 and amount in Database 2)?

_ If you delete a single cells value in either column H or column I, then the existing macros will do what you want already.- That is because you have effectively changed the cells value from what it was to another value of an empty string. That new empty string value will be put in the cell, so to our eyes it will look empty. The end result is what you want.
(In computer VBA language an “empty cell” can be truly Empty or it can have a value that to us as Humans is the same – it can have a value of a zero length string.
So that zero length string value is put in the cell by the existing coding if you remove a value from a cell in either column H or column I, which to our human eyes looks like the cell is empty. Some smarter computer experts might explain that a bit better, but at the end of the day it all amounts to a similar final result as far as we are concerned)

Originally Posted by Atlantis764

..Do you think it is possible to help me with this change in the VBA code so that when I delete ….. the entire row in Database), that amount is also deleted from the related database (hours in Database1 and amount in Database 2)?

Well, sort of…..
_ You can allow for pretty well any event to cause something to happen. It is just a case of how complicated the final macro will end up. Sometime it’s a better idea if you try to limit what can be done to what your really need. But that is all up to you and how important it is and how much time it saves you. Any code can go wrong or have unexpected bugs in the future, so its always best to think beforehand what you really need – the more longer and more complicated a coding is, the higher likelihood of course of something unexpected occurring later. But it’s down to you to decide on all that.

Nothing is difficult to do. But it is just a lot of simple and tedious coding and becomes inefficient the more you want to do. I am reluctant to go too far helping in this direction as the coding is not difficult, but just takes time. So I start going away from helping you and just start doing your work for you.

I give you one example:
Lets say you want the macro to remove from the related database (hours in Database1 and amount in Database 2) when you remove all values in columns A to I in worksheet Database

This gets very tedious and complicated as you are removing the information you need to figure out what row and column you want to access and remove data from in Database1 and database2 !!!!!!

To start with , towards the top of the Database worksheet code module you need variables to catch that required information before you remove it.

Code:

' These are sometimes called global variable
Dim strSrching As String
Dim DteVee2 As Long

Now we need to make use of another of the event macros that Microsoft already has there and lets us add to. It is the one that runs every time you select something.
So my idea is that, in that event macro, I put coding which will store that information when you select a row in columns A to I, in one go. ( Note I am meaning selecting a range 1 row and 9 columns. If you prefer it to be when you select the entire row, that is just as possible, but different extra coding once again )

Like this

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim TgRw As Long: Let TgRw = Target.Row ' the changed target row
    If Target.Column = 1 And Target.Columns.Count = 9 And Target.Rows.Count = 1 Then
    ' fill the global variable in case the values are about to be removed
     Let strSrching = Range("E" & TgRw & "").Value & Range("F" & TgRw & "").Value & Range("G" & TgRw & "").Value
     Let DteVee2 = Range("D" & TgRw & "").Value2
    Else
    End If
End Sub

Then we need this sort of thing to replace our existing coding.
First
_.. remove the worksheet variable assignments, and target row variable assignment further down in the existing coding because you are not allowed to assign variable more than once, and I need to do it in the new bit I will give you below
_.. change the check in the existing coding to exit on multiple cells count to maybe check for multiple row count instead like If Target.Rows.Count <> 1 Then Exit Sub
( Of course you could also arrange that you could delete values in multiple rows, but once again , more and more complicated coding to allow for all that… )
_.. possibly some other things I have not thought about at first thought. There might be some other variable assignments to remove the duplicate of, for example.

Then
This new coding (to replace the existing Worksheet_Change coding)
You will need to add to that a version of the existing coding, modified a bit as I partly explained

Code:

Private Sub worksheet_Change(ByVal Target As Range)
Dim WsD1 As Worksheet: Set WsD1 = ThisWorkbook.Worksheets("Database1")
Dim WsD2 As Worksheet: Set WsD2 = ThisWorkbook.Worksheets("Database2")
    If Target.Column = 1 And Target.Columns.Count = 9 And Target.Rows.Count = 1 Then
    Dim TgRw As Long: Let TgRw = Target.Row ' the changed target row
    ' check if all cells are empty
    Dim Clm As Long, strTxt As String
        For Clm = 1 To 9
         Let strTxt = strTxt & Cells.Item(TgRw, Clm).Value
        Next Clm
        If strTxt = "" Then  ' This means all cells are empty (or have a zero length strings in them)
        ' First we need to get the row and column infomation as before ( buit the info we need is not there anymore as we just removed it!! )
                    'Dim strSrching As String ' we need to have got this filled before we removed all the info
                    ' Let strSrching = Range("E" & TgRw & "").Value & Range("F" & TgRw & "").Value & Range("G" & TgRw & "").Value
        Dim arrDee1() As Variant: Let arrDee1() = WsD1.Evaluate("=A1:A25 & B1:B25 & C1:C25")
        Dim MtchRow As Long
         Let MtchRow = Application.Match(strSrching, arrDee1(), 0) ' this tries to match the correct row
        Dim arrDts() As Variant: Let arrDts() = WsD1.Evaluate("=IF({1},A1:K1)")
                    'Dim DteVee2 As Long: Let DteVee2 = Range("D" & TgRw & "").Value2 '  we need to have got this filled before
        Dim MtchColm As Long
         Let MtchColm = Application.Match(DteVee2, arrDts(), 1) ' this tries to match the correct row in Database1  using a 1 as the third argument im match will get the neartest next date match
        
        'now we can "empty" the old data
         Let WsD1.Cells.Item(MtchRow, MtchColm).Value = ""
         Let WsD2.Cells.Item(MtchRow, MtchColm).Value = ""
        Else
        End If
    Else
'
'
'
'
'    '  here goes all the rest, the existing coding, a bit modified as necessary
'
'
'
'
'
    End If
End Sub

I think you can see it’s getting complicated and tedious, and takes a while to “develop” but not difficult.

The other thing to bear in mind is that Program “development” as we are doing is extremely inefficient. It is very good for learning purposes, ( and also very good if you are paid to be a program “developer” since you will have plenty of work to be paid for. )

If you want to do the job efficiently it is almost always better to think very hard of what you want to do and be like 99.99% sure of everything you want to do before you start.
Otherwise it takes a lot longer and also the final thing you come up with will be a mess of patched together bits and almost certainly not the best final solution

Alan

**Atlantis764** · 03-10-2023, 04:40 PM

Originally Posted by DocAElstein

The other thing to bear in mind is that Program “development” as we are doing is extremely inefficient. It is very good for learning purposes, ( and also very good if you are paid to be a program “developer” since you will have plenty of work to be paid for. )

If you want to do the job efficiently it is almost always better to think very hard of what you want to do and be like 99.99% sure of everything you want to do before you start.
Otherwise it takes a lot longer and also the final thing you come up with will be a mess of patched together bits and almost certainly not the best final solution

Alan

Hi Alan,

Thanks again for all your help and support!
You are absolutely right: it is very good to determine exactly what you want from the beginning of the project before you start working.
The idea from which I initially started with this project was the following:
I made a User form in excel (and I was very proud of my achievement

) in which I entered the data (the fields from the User Form were exactly the dates from the top row of the Database) for each expert at the end of each month.
Every time I save the data in the User form, they are automatically written as a new row in the Database sheet, the values from the "Worked hours" column to the correct position in Database1 and the values from the "Amount" column to the correct position in Database2.
I managed to make the VBA code so that all the steps above work correctly.
After about a year of working with this file and several hundred recordings in it, I realized that it is a repetitive work at the end of each month and that this activity is very time-consuming.
Reaching this moment (I admit that I should have thought faster) I thought that I could finish the job much faster if I actually copy-paste the previous data from the Database - rows previously entered (without entering the data in the User form) and just changed the month, hours and amount.
That's the reason why I asked for your help in this post.
I will try to look very carefully at the explanations given by you in the previous post and modify what you suggested. I admit that I already tried to modify it but I couldn't get it to work (due to the fact that I'm a rookie) not because your explanations weren't very accurate.
I sincerely hope that over the weekend I will reach a positive result.

Thanks again for all your help and support!

Best regards,
Liviu

**lucilla** · 04-08-2023, 11:29 AM

Code:

Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, i As Long, fn As Range
Set sh1 = targetWorkbook.Sheets(SheetName) 'Master
Set sh2 = QlikWorkbook.Sheets(1) 'Qlik Data
lr = sh1.Cells(Rows.Count, 1).Row
    For i = 2 To lr 'Assumes header on new sheet.
        With sh2
              Set fn = sh1.Range("A:A").Find(.Cells(i, 1).Value, .Range("A1"), xlValues, xlWhole, xlByRows, xlPrevious)
                If Not fn Is Nothing Then
                    .Cells(i, 1).EntireRow.Copy fn
                End If
        End With
    Next