I wrote a very simple code for a few columns, starting with column D. Copied values from column D14:D85 and pasted it in prior column C14:C85 and cleared the column D range. All within same sheet. However, there is like 100 plus columns, how do I simplify this code to apply to all columns in this sheet without writing column by column lines of code.
Code Example:
Sub Copy_EndBal_BegBal()
Range("D14:D85").Select
Selection.copy
Range("C14").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("D14", "D85").ClearContents
Range("F14:F85").Select
Selection.copy
Range("E14").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("F14", "F85").ClearContents
Range("H14:H85").Select
Selection.copy
Range("G14").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("H14", "H85").ClearContents
Range("J14:J85").Select
Selection.copy
Range("I14").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("J14", "J85").ClearContents
Related
I have a macro which is designed to autofilter for certain criteria and then hide certain columns and copy what is left to the appropriate file. Sometimes the file filters correctly, but sometimes it stops on the Selection.AutoFilter line with a RE 1004 error, "Method of range class failed". This usually happens if I run the macro immediately after opening the file. If I reset the entire sheet with a macro I have to unhide everything, it filters correctly.
If it does filter correctly, it omits certain columns when pasting to the destination file. Those columns are the first one right after a handful of blank ones. I need it to copy either all visible columns except the header, or can even be changed to columns A - X, as that is the extent of the information required.
Here is the macro
Sub OO_Away_Lay_1()
'
' OO Away Lay v1 Macro
' This macro will filter for 1x2
'
Dim ws As Worksheet, lc As Long, lr As Long
Set ws = ActiveSheet
'range from A1 to last column header and last row
lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
lr = ws.Cells.Find("*", after:=ws.Range("A1"), LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With ws.Range("A1", ws.Cells(lr, lc))
.HorizontalAlignment = xlCenter
Selection.AutoFilter
.AutoFilter Field:=24, Criteria1:="Draw", Operator:=xlFilterValues
If .Rows.Count - 1 > 0 Then
On Error Resume Next
.Columns("L:S").EntireColumn.Hidden = True
.Columns("U:W").EntireColumn.Hidden = True
.Columns("Y:CK").EntireColumn.Hidden = True
.Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
On Error GoTo 0
Else
Exit Sub
End If
End With
Workbooks("Predictology_Trading Template v3.1.xlsm").Sheets("OO Away Lay v1") _
.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
Any thoughts on fixing it so it autofilters all the time and also copies all of the required data?
cheers
My match pattern has 4 parts :
<1st part><2nd part><3rd part><4th part>
Here,
<1st part> = Fixed string "Fedora"
<2nd part> = A 2 digit number "[0-9][0-9]"
<3rd part> = Followed by a ":" symbol.
<4th part> = one or more strings till the end of the current line.
NOTE : <4th part> ends with the end of current line and contains only alphabets.
I've reached till here :
Fedora[0-9][0-9]?[a-z]*[A-Z]*^l>
But the last part - searching the end of the line - is not yielding the expected result. Note that I'm trying to get the end of the line when Word breaks the line automatically.
Where am I going wrong ?
It seems to me you need:
Find = Fedora[0-9]{2}:*^l
or:
Find = Fedora[0-9]{2}:*[^l^13]
There is no way to use Word's built-in Find to locate the end of a line that's been generated by Word's automatic layout. The only kind of "end-of-line" that can be searched is the manual line break inserted by pressing Shift+Enter. The manual line break corresponds to the special Find character ^l.
If you need to Find and extend to the end of a line then you need to use a macro (VBA). The following sample code does what you need. Please note that with the code as it stands only the last occurrence of the search term will be selected when the macro finishes. You need to build the final result into it that you're looking for.
Or, simply remove the Do While and Loop lines and the macro will find the first term.
Sub FindThenToEndOfLine()
Dim r As Range, rDoc As Word.Range
Dim bFound As Boolean
bFound = True
Set r = ActiveDocument.content
Set rDoc = r.Duplicate
r.Find.ClearFormatting
Do While bFound
With r.Find
.text = "Fedora[0-9][0-9]:[a-z]*[A-Z]*"
.Forward = True
.wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
bFound = .Execute
End With
If bFound Then
r.Select
Selection.EndKey Unit:=wdLine, Extend:=True
End If
Loop
End Sub
This Macro is used to cut, insert and delete a cell range section of a workbook.
The problem I was trying to solve and gave up with the lack of response in another thread is why copying multiple non-adjacent rows to the MS clipboard often loses their row line-breaks when pasting.
E.g. Since trying to paste 3 non-adjacent rows into row 10, 11 and 12, often puts all 3 rows into row 10 with one row in fields A10-P10, the next row in Q10-AF10 and the last row into AG10-AV10...
I edited the Macro below to fix this mistake when this happens.
So, for example, I can now highlight row 10 and run the macro to cut/insert the fields Q10-AF10 to A11-P11 and delete/shift left the blank fields now in Q10-AF10.
I'm hoping for help to loop this process until there's no data outside Column A-P. In this case, no data outside cell P10.
Sub FixAllOnLine1OneRowAtATimeInsertToNextRow()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = ActiveSheet
Set pasteSheet = ActiveSheet
copySheet.Range("Q" & ActiveCell.Row & ":AF" & ActiveCell.Row).Copy
Range("Q" & ActiveCell.Row & ":AF" & ActiveCell.Row).Offset(1).Select
pasteSheet.Cells(ActiveCell.Row, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
Columns("Q:AF").Select
Selection.Delete Shift:=xlToLeft
End Sub
Ok, I made some headway. I just have one super easy issue and then I need to loop it.
The first issue is that it cuts Column Q:AF correct of the row I've highlighted and shifts the entire Column Q:AF to the left, but it INSERTS the cut cells into the fixed range, A2:P2. I want to INSERT the cut cells down ONE row from my selection. I KNOW this is a couple characters in the Offset, I just can't get it.
Then, once it's working properly...say I highlight row 10, it cuts Q10:AF10 and instead INSERTS the cells into A11:P11 and shifts "Q:AF" to the left, then I need to figure out how to get it to loop until there's no more data to right of Column P. When this problem occurs pasting multiple rows from the clipboard all into the first row losing the row line-breaks, it's always quite a few rows.
Any ideas?
Thanks so much!
Mark
Sub FixAllOnLine1OneRowAtATimeInsertToNextRow()
Dim ws As Worksheet
Dim lNextRow As Long
Application.ScreenUpdating = False
Set ws = ActiveSheet
ws.Range("Q" & ActiveCell.Row & ":AF" & ActiveCell.Row).Copy 'Copy the row of the selected cell from Q:AF
ws.Range("Q" & ActiveCell.Row & ":AF" & ActiveCell.Row).Offset(1).Select 'Select the cells you have just copied. Not needed
ws.Cells(ActiveCell.Row, 1).End(xlUp).Offset(1, 0).Insert xlShiftDown ' Paste the copied values in to column "A" on next row?
'lNextRow = ws.Range("A" & Rows.count).End(xlUp).Row + 1 'Get Next Row number
'Range("A" & lNextRow).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Range("Q:AF").Delete Shift:=xlToLeft
'Columns("Q:AF").Select
'Selection.Delete Shift:=xlToLeft
Application.ScreenUpdating = True
ActiveCell.Offset(RowOffset:=-1, columnOffset:=0).Activate 'Added to move active cell up one row to run it again for multiple groups to apply fix.
End Sub
Here's a solution in another direction just in case someone from the engines needs it...
Sub ReduceNoOfColumns()
Dim iRow As Integer 'Row to be manipulated
Dim iRowToPasteTo 'Row number to paste the copied cells
Dim iCurCol As Integer 'Current Column number of first cell with a value to cut
Dim NoOfCols As Integer 'integer to hold max number of columns
Dim sAddress As String
iRow = ActiveCell.Row
iRowToPasteTo = iRow + 1
NoOfCols = 16 'Set this number to the total number of columns you wish to have (in your case 16)
iCurCol = NoOfCols + 1
Do Until Cells(iRow, iCurCol).Value = "" 'Keep looping until we get to an empty column
sAddress = ColNoToLetter(iCurCol) & iRow & ":" & ColNoToLetter(iCurCol + NoOfCols - 1) & iRow
Rows(iRowToPasteTo & ":" & iRowToPasteTo).Insert Shift:=xlDown
Range(sAddress).Copy
Range("A" & iRowToPasteTo).PasteSpecial xlPasteAll
Range(sAddress).Clear
iCurCol = iCurCol + NoOfCols
iRowToPasteTo = iRowToPasteTo + 1
Loop
End Sub
Function ColNoToLetter(iCol As Integer) As String
Dim vArr
vArr = Split(Cells(1, iCol).Address(True, False), "$")
ColNoToLetter = vArr(0)
End Function
I currently have an Excel 2010 spreadsheet. I have designed a form and I'm looking to allow users to enter date into the form and it then be entered into the worksheet.
My first entry is "txtDate" on my form and I wish for this to be entered into cell J7 with the next data in the form "txtTime" going into cell K7 and then other data into other cells in the row - L7, M7, N7 etc etc... Once this cell is submitted with a button using on the form, the data is entered and then the next time the form is used, the data will go into the next row below, row 8 and then row 9 on the next occasion etc...
I've found the sample below code on the internet and the example shows that it starts in cell A2. I can't see mention of A2 and so I'm wondering how I edit the code to start in cell J7.
'Copy input values to sheet.
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Animals")
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With ws
.Cells(lRow, 1).Value = Me.cboClass.Value
.Cells(lRow, 2).Value = Me.txtGivenName.Value
.Cells(lRow, 3).Value = Me.txtTagNumber.Value
.Cells(lRow, 4).Value = Me.txtSpecies.Value
.Cells(lRow, 5).Value = Me.cboSex.Value
.Cells(lRow, 6).Value = Me.cboConservationStatus.Value
.Cells(lRow, 7).Value = Me.txtComment.Value
Here is my code dated 27/03/2015 following the answer:
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Pursue")
lRow = Application.WorksheetFunction.Max(ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row, 7)
With ws
.Cells(lRow, 10).Value = Me.dateBox.Value
etc....
.Cells(lRow, 1).Value (and so forth) is what references what cell is written to. The first argument says what row the cell is in, the second what column it is in. When referencing the cells explicitly I see little reason to do it this way though, it is mainly for when you'd make a loop where e.g. lRow was incremented by one for each iteration in order to write down a column.
Since lRow is decided using lRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row it will always be the number of the first empty row in column A. To change it to return the first empty row in column J, you need to change the 1 in Cells to 10 (J is the 10th letter in the alphabet. To get it to not start further up than row 7 at any time, I'd add in a Max-statement:
lRow = Application.WorksheetFunction.Max(ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row, 7)
To get the sub to write to column J onwards inside the With-statement, you need to change the column-references to reflect this. Currently it writes to column 1, 2, 3, etc. you want it to write to column 10, 11, 12, etc. I.e. something like:
With ws
.Cells(lRow, 10).Value = Me.cboClass.Value
.Cells(lRow, 11).Value = Me.txtGivenName.Value
.Cells(lRow, 12).Value = Me.txtTagNumber.Value
etc.
The autofilter is sorting data vertically, but I want to filter rows horizontally.
Lets say that I have the following table:
1 2 2 1 2
B A E F F
B D E F F
C D E F F
What I can do is to set an autofilter and filter only the rows containing "B" in the first column. What I would like to do is to filter only the rows that contain "2" (in this case the rows are second, third and the last in this case).
I have found some information regarding this matter. All of the answers I found are containing some macros to get the job done, but they were written for MS Excel, and are not compatible with OpenOffice
For example, this macros should get the rows filtered, but is not working in OpenOffice Calc:
Option Explicit
Sub horizontal_filter()
'Erik Van Geit
'060910
Dim LC As Integer 'Last Column
Dim R As Long
Dim i As Integer
Dim FilterValue As String
Const FilterColumn = 1 '1 is most logical value but you may change this
R = ActiveCell.Row
LC = Cells(R, Columns.Count).End(xlToLeft).Column
FilterValue = Cells(R, FilterColumn)
Application.ScreenUpdating = False
'to filter starting after FilterColumn
For i = FilterColumn + 1 To LC
'to filter all columns even before the filtercolumn
'For i = 1 To LC
If i <> FilterColumn Then
Columns(i).Hidden = Cells(R, i) <> FilterValue
End If
Next i
Application.ScreenUpdating = True
End Sub
Any help is greatly appreciated!
You can't, under the assumption of reasonable expense. It's much easier just to transform your data so that rows get columns and vice versa. So, i would strongly recommend transforming the data using Paste Special together with the Transpose option. You could even do this dynamically by using the TRANSPOSE() function.
EDIT:
Now i got it - you want to hide columns based on a certain value. This is possible using a macro in fact, so my first answer was incorrect - sorry for that! There are some macros around that will do this for you. You can combine such a solution with an auto filter. Here's a solution by king_026 from the OpenOffice.org forums (slightly adapted to table structure - see below):
REM ***** BASIC *****
sub hide
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem get the current column
nCol = ThisComponent.CurrentSelection.CellAddress.Column
rem set the properties for moving right
dim args2(1) as new com.sun.star.beans.PropertyValue
args2(0).Name = "By"
args2(0).Value = 1
args2(1).Name = "Sel"
args2(1).Value = false
rem make thecurrent column counter
dim cCol as integer
CCol = 0
rem goto the first column
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$A$2"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem loop until you get back to the selected cell
Do Until cCol > nCol
rem hide if the cell value is 1
if ThisComponent.CurrentSelection.string <> "" and ThisComponent.CurrentSelection.value = 1 then
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:HideColumn", "", 0, Array())
End if
rem goto the right nad increment the column counter
dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args2())
cCol = cCol + 1
Loop
End sub
So, the following table:
will look like this after Autofilter on Col1 and after the macro did his work: