I am having three Sheets, Sht1 having my Basic data, sht2, having an data from last week, sht3 having an data with present week.
I am copying the data from sht1 to sht3, which ever has an Status red in columnJ.
After copying, i look into the lastweek sht and check for value in L and then fill the column N,O,P in sheet thisweek.
In the next step, whenever i click a button, the lastweeksht should be update by the data in present week sheet and present week should be deleted and evaluated with the new result. How can i do it. I should do the last step of moving the data to last week and updating thisweek to new result ? I am confused how to do this.
below are the codes, where i am using for copying the Status from Basic sht to this week and the vlookup formula i am using in thisweek.
Sub red()
Dim cell As Range
Dim nextrow As Long
Application.ScreenUpdating = False
For Each cell In Sheets("Red").Range("J5:J" & Sheets("Red").Cells(Sheets("Red").Rows.Count, "J").End(xlUp).Row)
If cell.Value = "rd" Then
nextrow = Sheets("ThisWeek").Cells(Sheets("ThisWeek").Rows.Count, "J").End(xlUp).Row
Rows(cell.Row).Copy Destination:=Sheets("ThisWeek").Range("A" & nextrow + 1)
End If
Next
Application.ScreenUpdating = True
End Sub
Sub lookup()
Dim tr As Long
Dim trsh As Long
tr = Sheets("ThisWeek").Cells(Rows.Count, "A").End(xlUp).Row
trsh = Sheets("ThisWeek").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("ThisWeek").Range("M2:M" & tr).Formula = Application.WorksheetFunction.IfError(Application.VLookup(Sheets("ThisWeek").Range("L2:L" & trsh), Sheets("LastWeek").Range("$A:$P"), 13, 0), "")
End Sub
Sub lookupredaction()
Dim tr1 As Long
Dim trsh1 As Long
tr1 = Sheets("ThisWeek").Cells(Rows.Count, "A").End(xlUp).Row
trsh1 = Sheets("ThisWeek").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("ThisWeek").Range("N2:N" & tr1).Formula = Application.WorksheetFunction.IfError(Application.VLookup(Sheets("ThisWeek").Range("L2:L" & trsh1), Sheets("LastWeek").Range("$A:$P"), 14, 0), "")
End Sub
Sub lookupredoverdue()
Dim tr2 As Long
Dim trsh2 As Long
tr2 = Sheets("ThisWeek").Cells(Rows.Count, "A").End(xlUp).Row
trsh2 = Sheets("ThisWeek").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("ThisWeek").Range("O2:O" & tr2).Formula = Application.WorksheetFunction.IfError(Application.VLookup(Sheets("ThisWeek").Range("L2:L" & trsh2), Sheets("LastWeek").Range("$A:$P"), 15, 0), "")
End Sub
Sub lookupcomments()
Dim tr3 As Long
Dim trsh3 As Long
tr3 = Sheets("ThisWeek").Cells(Rows.Count, "A").End(xlUp).Row
trsh3 = Sheets("ThisWeek").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("ThisWeek").Range("P2:P" & tr3).Formula = Application.WorksheetFunction.IfError(Application.VLookup(Sheets("ThisWeek").Range("L2:L" & trsh3), Sheets("LastWeek").Range("$A:$P"), 16, 0), "")
End Sub
this how the Basic data of my sheet Looks like. I always take the data from database and paste in this way
Image 1
First half is the Image of the second sheet. I call this sheet as last week. This sheet has an extra column E and F with Actions and no Actions evaluated. For now, this sheet is taken from the calculations of last week. in column G i have an formula, which calculates the CW. below is the sample Image of my third sheet, i call this as this week. In column G again i have an formula that calculates the CW. Here i use the first code, which always copy the Status with red to my this week.then, I use lookup codes to look into the ID in column A (as per dumy sheet) and copy the Actions and no Actions, accordingly.
Image 2
Now what i would like to have is, an button in my Basic sheet, and when i click the button, it should delete the last week and update the data of this week to last week . This week data should be deleted.
Later i have an button in my Basic sheet, which will include all the codes i have in the post and i could calculate for the new set of data. I have half done and left with other half struck how to achieve. Could someone help me achieve this. I would be thankful to you. and would improve myself with programing. Thank you in advance.
Posting this as an answer as it worked for you,
Use Range.ClearContents to clear the data in your lastweek sheet
Use Range.Copy Destination to copy the data from presentweek to lastweek
Clear the data in presentweek using clear contents.
You can use Sheets("ThisWeek").Range("A1:B10") (example) to operate different sheets with the same macro.
Related
Hellow,
I have a problem with copy past code
I can't identify the last cell in the row "where I would like to past" !!?
Here in the next code, I wrote "Shet.Cells(Rows.Count, "N").End(xlUp).row + 1", and it works well just in case there are no hidden rows, except that last row's value always replace itself !!
So, what should I do to update last row's value every time I execute Sub Copy_Past() ???
Sub Copy_Past()
Dim Shet As Worksheet
Set Shet = ThisWorkbook.Sheets(1)
Dim LRow As Long
'To get the latest cell in the column "N", where I would like to paste my data.
LRow = Shet.Cells(Rows.Count, "N").End(xlUp).row + 1
'To make a copy form where I selected
Selection.SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Cells(LRow, "M")
'To delete the range of data that I selected and after coping them
Selection.SpecialCells(xlCellTypeVisible).Delete (xlShiftUp)
End Sub
I found a solution for this :)
I brought this method from here
https://answers.microsoft.com/en-us/msoffice/forum/msoffice_excel-msoffice_custom-mso_2007/finding-last-row-including-hidden-rows/af0d7d7c-84f1-44bf-b36a-5abc98a93fa6
Sub xlCellTypeLastCell_Example_Column()
For LastRow = Columns("N").SpecialCells(xlCellTypeLastCell).row To 1 Step -1
If Len(Cells(LastRow, "N").Formula) Then Exit For
Next
MsgBox LastRow
End Sub
I am building a calendar in Excel that automatically maps event information from a table to a dynamic calendar view. Each row represents a time from 8AM - 6PM, and each column represents a day of the week from Sunday - Saturday. I was able to map information for each unique event to two separate cells in each column, one for start time and one for end time. I am looking for help with building a macro to merge the cells containing the same information into one so the calendar is cohesive. E.g. Event A starts at 9AM and ends at 11AM. There is currently one cell populated at 9AM and one at 11AM, but the cell for 10AM is blank and I'd like to merge the two populated cells from the 9AM cell to 11AM cell. As the populated cells will not always be adjacent, the offset function doesn't seem to work in this case.
Here is the pseudo code I'm trying to accomplish:
For each column in a specified region
loop through each row
if two cells contain identical text
merge those two cells
Here is the little bit of code I've managed to come up with so far. You can tell there are many gaps and probably syntax errors:
Sub MergeCells
Dim cells As String
cells = ActiveSheet.Range("C8:V28,C31:V51,C54:V74,C77:V97,C100:V120")
If ActiveSheet.Range(cells).??? Then
ActiveSheet.Range(cells).Merge
End If
End Sub
Any help would be greatly appreciated!
Before picture
After picture
Okay - this may be overkill, and you may need to tweak, but this was fun to work on.
Sub combine_Same()
Application.DisplayAlerts = False
Dim tableRng As Range
Dim i As Long, k As Long, lastRow As Long
Dim curText As Range, prevText As Range
Dim tableRanges As Variant
tableRanges = Split("b3:e20,C31:V51,C54:V74,C77:V97,C100:V120", ",")
Dim rng As Long
For rng = LBound(tableRanges) To UBound(tableRanges)
Debug.Print "Working with: " & tableRanges(rng)
Set tableRng = Range(tableRanges(rng))
' tableRng.Select
lastRow = tableRng.Rows(tableRng.Rows.Count).Row
For k = tableRng.Columns(1).Column To tableRng.Columns.Count
For i = lastRow To tableRng.Rows(1).Row Step -1
Set curText = Cells(i, k)
Set prevText = curText.End(xlUp)
If curText.Value = prevText.Value And Not IsEmpty(curText) Then
'curText.Select
Range(curText, prevText).Merge
curText.VerticalAlignment = xlCenter
ElseIf curText.Value = curText.Offset(-1, 0).Value And Not IsEmpty(curText) Then
'curText.Select
Range(curText, curText.Offset(-1, 0)).Merge
curText.VerticalAlignment = xlCenter
End If
Next i
Next k
Next rng
Application.DisplayAlerts = True
End Sub
I need code, as my title suggests, for the following task. I already tried a lot of different code but it's still not working.
I only need to move 2 columns, "SKU" and "Discount", into sheet2 using command button and delete it right away.
I'm already okay for this coding. However, but the problem is just beginning.
When I succeed to moved the first data, and try to move the 2nd data, the 1st data disappears.
I already tried many ways but still can't figure it out what's wrong with the code.
Please check the following code:
Sub OUTGOING_GOODS()
function1
function2
clear
Range_End_Method
End Sub
Sub function1()
Sheets("Invoice Print").Range("B21:B27").Copy Destination:=Sheets("Outgoing Goods").Range("D4")
End Sub
Sub function2()
Sheets("Invoice Print").Range("D21:D27").Copy Destination:=Sheets("Outgoing Goods").Range("L4")
End Sub
Sub clear()
Range("B21:B27").clear
End Sub
I also need to change the range for input data as well. As you can see the Range is defined only from D21:D27, but I need more than row 27 just in case there is additional data inputted.
Already tried the following code:
With Worksheets("Sheet2")
LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
LastRow = .Cells(.Rows.Count, "L").End(xlUp).Row
For Each cell In Range("D4:D" & LastRow)
DestinationRow = LastRow + 1
Next
For Each cell In Range("L4:L" & LastRow)
DestinationRow = LastRow + 1
Next
End With
And
Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To InputData
Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
For j = 1 To 3
.Cells(lastrow + 1, j).Value = InputData(i, j)
Next j
Next i
End With
This still isn't working.
Based on our discussions thus far I'd suggest the following:
Sub Outgoing_Goods_New()
'
Dim Outgoing As Worksheet 'Generally it's better to use Worksheet variables. Saves the trouble of having to re-type the sheet name each time you reference the sheet
Dim Invoice As Worksheet
Dim LastRow_Invoice As Long
Dim LastRow_Outgoing As Long
Set Outgoing = ActiveWorkbook.Worksheets("Outgoing Goods")
Set Invoice = ActiveWorkbook.Worksheets("Invoice Print")
'Find the last row of Outgoing column D that's used so we know where to paste the new set of outgoing goods
LastRow_Outgoing = Outgoing.Range("D1048576").End(xlUp).Row
'Make sure column L of Outgoing ends at the same point
If Outgoing.Range("L1048576").End(xlUp).Row > LastRow_Outgoing Then
LastRow_Outgoing = Outgoing.Range("L1048576").End(xlUp).Row
End If 'else column L's last used row is farther up the worksheet or the same row. Either way no need to update the value
'Determine how much data to copy
LastRow_Invoice = Invoice.Range("B1048576").End(xlUp).Row 'I'm assuming Column D of Invoice Print has to end at the same row. If not, use the same IF statement as above, but
'checking column D of Invoice
'Copy the data from column B
Invoice.Range("B2:B" & LastRow_Invoice).Copy
'Paste to Outgoing Goods
Outgoing.Range("B" & LastRow_Outgoing).PasteSpecial xlPasteAll
'Copy Column D of Invoice
Invoice.Range("D2:D" & LastRow_Invoice).Copy
Outgoing.Range("L" & LastRow_Outgoing).PasteSpecial xlPasteAll
'Clear the data from Invoice print
Invoice.Range("B2:B" & LastRow_Invoice).ClearContents 'Removes the Value, but leaves formatting, comments, etc. alone
End Sub
This is mostly the logic you already had, but I did some clean-up to remove ambiguities and genericize the logic a little. Also, notice that I didn't keep the separate Subs. With how little you're doing there's just not any benefit to parsing the logic, especially with none of the code being re-used.
Last, I didn't delete column D on Invoice Print assuming that the cells just held formulas that pull in new data based on the values in Column B. If that's not the case, it seems like you should add a second ClearContents to delete Column D as well, but that's not certain given the vagueness of your use case.
I know, I know. There are a ton of suggestions how to solve that particular problem, but somehow they all tend to fail with me.
What I have (simplified): A (Mac) Excel-Sheet "Output" with:
Name Time Date
Mike 08:00 01.01.2016
The second row is yielding the data based on some input on yet another sheet.
What I need:
Whenever I will change the second row of "Output" (i.e. changing the input), I can click a button to add the entire second row onto a new worksheet "Log" (that will feature a header as well). Essentially logging the data upon clicking the button. The data can only be added once, multiple entries of the same data are deleted. After logging the data in "Log", the second row of "Output" does not need to be cleared, however I should not be able to add the same data again.
Any thoughts?
*EDIT
I modified the code from here: http://goo.gl/48jjDo.
Sub Submit()
Application.ScreenUpdating = False
Dim refTable As Variant, trans As Variant
refTable = Array("A = A2", "B = B2", "C=C2")
Dim Row As Long
Row = Worksheets("Log").UsedRange.Rows.Count + 1
For Each trans In refTable
Dim Dest As String, Field As String
Dest = Trim(Left(trans, InStr(1, trans, "=") - 1)) & Row
Field = Trim(Right(trans, Len(trans) - InStr(1, trans, "=")))
Worksheets("Log").Range(Dest).value = Worksheets("Output").Range(Field).value
Next
Application.ScreenUpdating = True
End Sub
*Edit2
Ok this got me further:
Sub CopyRangeFromSheet1toSheet2()
Dim lastRow As Long
lastRow = Sheets("Sheet2").Range("A100000").End(xlUp).Row + 1 ' then next free row in sheet2
Sheets("Sheet1").Range("A2:C2").Copy Destination:=Sheets("Sheet2").Range("A" & lastRow)
End Sub
However, how do I check now for multiple data? And I will need to paste only the values.
So far this works:
Sub CopyFormulas()
Dim sht1 As Worksheet, sht2 As Worksheet
Set sht1 = Sheets("Output")
Set sht2 = Sheets("Log")
sht1.Range("A2:C2").Copy
sht2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
response = MsgBox("data was added")
End Sub
Not it is only the check for multiple entries that is missing
I am trying to keep the last 365 days visible in a micro tracking worksheet. As a new date gets inputted it would hide the first visible entry on the sheet so that only 365 cells are constantly displayed with the newest date at the bottom(ex Jan 15, 2015) and the oldest date at the top(Jan 15, 2014). When the user inputs Jan 16, 2015 it would hide Jan 15, 2014 so that the first entry is now Jan 16, 2014, and so on.
It has probably been about 15 years since I last used VBA but currently the code shown below will hide row 3 (where the first date and data is entered) but after that I can't get it to then hide row 4 once row 369 has text entered. Some insight into what I might be doing wrong would be greatly appreciated.
I would also assume that as this sheet became progressively larger it would start to slow down in opening or running smoothly so I would have to start fresh unless there is a way to make sure it always stays fast.
Dim i As Integer
Dim j As Integer
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
i = 3
j = 368
If Cells(j, j) = "" Then
Rows(i).Hidden = True
End If
i = i + 1
j = j + 1
End Sub
This is a completely different approach, but might suit you better in the long run.
Instead of hiding the rows to view what you are interested in. This approach uses two sheets.
Log Sheet: Contains all days
Report Sheet: Re-fills with only the last 365 days.
Setup Involved:
Set a second sheet up for your report, and give it the same headers as your Log Sheet.
Place the code provided in a module
If you want, you can add a workbook event so when the workbook opens, you can call this sub and have it update itself, or attach it to a hotkey or button.
This gives you plenty of room to create new formulas and charts to work over the set range of the report sheet. You can hide the Log Sheet.
Code:
Sub lastYearReportFill()
Dim lastRow As Long, lastCol As Long, lRow As Long, rRow As Long
Dim log As String, report As String
Dim today As Date, tempDate As Date
Dim daysTest As Long
log = "Log" 'Name your worksheets here
report = "Report"
today = Now
lastRow = Sheets(log).Range("A" & rows.count).End(xlUp).row
lastCol = Sheets(log).Cells(2, Columns.count).End(xlToLeft).column 'Using Header Row
For lRow = 3 To lastRow
tempDate = Sheets(log).Cells(lRow, 1)
daysTest = DateDiff("d", tempDate , today)
If daysTest = 365 Then
Exit For
End If
Next lRow
For rRow = 3 To 368
For lCol = 1 To lastCol
Sheets(report).Cells(rRow, lCol).Value = Sheets(log).Cells(lRow, lCol).Value
Next lCol
lRow = lRow + 1
Next rRow
End Sub
This should do the trick:
Sub HideRows()
Dim lngLastRow As Long
lngLastRow = Sheets("Sheet1").Cells(1, 1).End(xlDown).Row
If lngLastRow < 365 Then End
Rows(lngLastRow - 365).Hidden = True
End Sub
This is assuming that:
you are working in a sheet named "Sheet1" (if not, change the name in line 3 of the code accordingly)
the dates are in column A and start in row 1 (even the hidden ones). If the dates are in a different column, then change the second number in the cells(1, 1) statement to the number of the row. And if the dates do not start in row 1, change the first number of the cells(1, 1) statement to the row number of the first date.
And if you want to keep the row for the day exactly one year ago (as in, keep 1-15-14 on 1-15-15), you may need to change 365 in line 5 of the code to 366. This code also assumes that all other rows besides the one that was visible yesterday but doesn't need to be today are already hidden.
If you are concerned with speed, use Range AutoFilter Method which I answered HERE.
Applying it to your case:
Private Sub UpdateVisibleDates(sh As Worksheet, drng As Range)
With sh
Dim latest As Date
latest = .Range("A:A").Find("*", .Range("A1"), , , , xlPrevious).Value2
.AutoFilterMode = False
drng.AutoFilter 1, ">" & (latest - 365), xlAnd, "<=" & latest, False
End With
End Sub
Then just call it in your Worksheet_Change Event.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo halt
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
Dim r As Range
Set r = Me.Range("A1:A" & Me.Range("A:A") _
.Find("*", Me.Range("A1"), , , , xlPrevious).Row)
UpdateVisibleDates Me, r
End If
forward:
Application.EnableEvents = True
Exit Sub
halt:
MsgBox "Error: " & Err.Number & vbCrLf & _
Err.Description, vbExclamation
Resume forward
End Sub
This is considering you have a complete date in Column A and your input doesn't skip dates.
But regardless, it will still hide dates not within the 365 date difference of the last entered date. HTH.