Hello world.
I have written a VBA code to find a value in one sheet, and if match, just copy the entire row.. OK, it is not only it, let me explain how it works and the problem I am facing:
First sheet, called "DATA";
Second sheet, called "WEEK UPDATE"
1 - The person paste a pre select data in sheet "WEEK UPDATE", then push the botton to check if the value existing in its sheet, exists in the sheet "DATA";
IF YES, then the row from A to AJ ("week update") is overwritten in sheet "data" in the same colluns
IF NOT, then the row from A to AJ ("week update") is PASTED in sheet "data" in the same colluns
2 - The system check if the data in sheet "data", do not exist in sheet "week update", so put a value in collum AN as "Historic"
IF the collunm is already as "Historic", and system find the value from "Data" in "week update", then the value "historic" is overwritten as "";
.. NOW MY PROBLEM...
It works very well, but with a small quantity of lines..
I am using 50K lines in "week update" and ~40K in "data", and then the macro does not work
any help, PLEASE ?
drive.google.com
follow the code:
[/CODE]
I have written a VBA code to find a value in one sheet, and if match, just copy the entire row.. OK, it is not only it, let me explain how it works and the problem I am facing:
First sheet, called "DATA";
Second sheet, called "WEEK UPDATE"
1 - The person paste a pre select data in sheet "WEEK UPDATE", then push the botton to check if the value existing in its sheet, exists in the sheet "DATA";
IF YES, then the row from A to AJ ("week update") is overwritten in sheet "data" in the same colluns
IF NOT, then the row from A to AJ ("week update") is PASTED in sheet "data" in the same colluns
2 - The system check if the data in sheet "data", do not exist in sheet "week update", so put a value in collum AN as "Historic"
IF the collunm is already as "Historic", and system find the value from "Data" in "week update", then the value "historic" is overwritten as "";
.. NOW MY PROBLEM...
It works very well, but with a small quantity of lines..
I am using 50K lines in "week update" and ~40K in "data", and then the macro does not work
any help, PLEASE ?
March_2020.xlsm

follow the code:
VBA Code:
Sub Preencher_dados()
Application.ScreenUpdating = False
Worksheets("Data").Unprotect Password:="Henkel2020"
Worksheets("Week Update").Unprotect Password:="Henkel2020"
Sheets("Data").Columns("AP").EntireColumn.Hidden = False
Sheets("Week Update").Columns("AK").EntireColumn.Hidden = False
linha = 3
contagem = 0
ultima_linha1 = Sheets("Data").Range("C80000").End(xlUp).Row
ultima_linha2 = Sheets("Week Update").Range("C80000").End(xlUp).Row
If ultima_linha2 <= 2 Then MsgBox "Não existem novos dados a serem transferidos.", vbExclamation: GoTo Final
'i = 3 'concatena coluna H e I da planilha Data
'Do While i <= ultima_linha1
' Sheets("Data").Cells(i, "AP") = CStr(Sheets("Data").Cells(i, "H") & Sheets("Data").Cells(i, "I"))
' i = i + 1
'Loop
'i = 3 'concatena coluna H e I da planilha Week Update
'Do While i <= ultima_linha2
' Sheets("Week Update").Cells(i, "AK") = CStr(Sheets("Week Update").Cells(i, "H") & Sheets("Week Update").Cells(i, "I"))
' i = i + 1
'Loop
'verificar adição de novas linhas (Secundária busca na primária)
linha = 3
texto = "Existem materiais que necessitam de revisão na(s) linha(s): "
Do While Sheets("Data").Cells(linha, "C") <> Empty
Var3 = Application.Match(Sheets("Data").Cells(linha, "AP").Value, Sheets("Week Update").Columns(37), 0)
If WorksheetFunction.IsError(Var3) Then 'caso 3: existe uma linha na planilha primária que foi deletada da semana atual
linha_apagada = linha
Sheets("Data").Cells(linha, "AN") = "Historic"
End If
If Not WorksheetFunction.IsError(Var3) And Sheets("Data").Cells(linha, "AN") = "Historic" Then 'caso 3: existe uma linha antes deletada que voltou semana atual
contagem = 1
texto = texto & vbCr & linha & ";"
Sheets("Data").Cells(linha, "AN") = Empty
End If
linha = linha + 1
Loop
Do While Sheets("Week Update").Cells(linha, "C") <> Empty
Var1 = Application.Match(Sheets("Week Update").Cells(linha, "AK").Value, Sheets("Data").Columns(42), 0)
If WorksheetFunction.IsError(Var1) Then 'caso 1: existe uma nova linha na semana atual
Sheets("Week Update").Cells(linha, 1).Resize(1, 36).Copy Destination:=Sheets("Data").Range("A80000").End(xlUp).Offset(1, 0)
End If
If Not WorksheetFunction.IsError(Var1) Then 'caso 2: não existe uma nova linha na semana atual -> subscrever
linha_sub = Sheets("Data").Columns(42).Find(Sheets("Week Update").Cells(linha, "AK"), LookIn:=xlValues).Row
Sheets("Week Update").Cells(linha, 1).Resize(1, 36).Copy Destination:=Sheets("Data").Cells(linha_sub, 1)
End If
linha = linha + 1
Loop
'verificar exclusão de linhas (primária busca na secundária)
'i = 3 'concatena coluna H e I da planilha Data
'ultima_linha1 = Sheets("Data").Range("A1048576").End(xlUp).Row
'Do While i <= ultima_linha1
' Sheets("Data").Cells(i, "AP") = CStr(Sheets("Data").Cells(i, "H") & Sheets("Data").Cells(i, "I"))
' i = i + 1
'Loop
Application.ScreenUpdating = True
If contagem = 1 Then MsgBox texto, vbExclamation
Final:
Sheets("Week Update").Rows("4:80000").Delete Shift:=xlUp
Sheets("Week Update").Range("A3:AJ3").ClearContents
Sheets("Data").Columns("AP").EntireColumn.Hidden = True
Sheets("Week Update").Columns("AK").EntireColumn.Hidden = True
Sheets("Data").Select
Worksheets("Data").Protect Password:="Henkel2020", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
Worksheets("Week Update").Protect Password:="Henkel2020"
Application.ScreenUpdating = True
End Sub